summaryrefslogtreecommitdiff
path: root/src/Run.hs
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2025-02-15 20:38:39 +0100
committerRoman Smrž <roman.smrz@seznam.cz>2025-02-24 21:43:09 +0100
commit3640256e80ba1aa1c1e022a231234dee814ace58 (patch)
tree4fa2fa9c97ceb54bcabd5136f47b70412ac0dbb4 /src/Run.hs
parent14efffc66cb60465c18c984311bde5a5502803db (diff)
Collect and evaluate global definitions together
Diffstat (limited to 'src/Run.hs')
-rw-r--r--src/Run.hs28
1 files changed, 14 insertions, 14 deletions
diff --git a/src/Run.hs b/src/Run.hs
index 4cd80a0..1b2f448 100644
--- a/src/Run.hs
+++ b/src/Run.hs
@@ -1,6 +1,7 @@
module Run (
module Run.Monad,
runTest,
+ evalGlobalDefs,
) where
import Control.Applicative
@@ -33,8 +34,8 @@ import Run.Monad
import Test
import Test.Builtins
-runTest :: Output -> TestOptions -> Test -> [ ( FqVarName, SomeExpr ) ] -> IO Bool
-runTest out opts test variables = do
+runTest :: Output -> TestOptions -> GlobalDefs -> Test -> IO Bool
+runTest out opts gdefs test = do
let testDir = optTestDir opts
when (optForce opts) $ removeDirectoryRecursive testDir `catchIOError` \e ->
if isDoesNotExistError e then return () else ioError e
@@ -59,7 +60,8 @@ runTest out opts test variables = do
, teGDB = fst <$> mgdb
}
tstate = TestState
- { tsVars = builtins
+ { tsGlobals = gdefs
+ , tsLocals = []
, tsNodePacketLoss = M.empty
, tsDisconnectedUp = S.empty
, tsDisconnectedBridge = S.empty
@@ -82,19 +84,12 @@ runTest out opts test variables = do
Stopped sig -> err $ T.pack $ "child stopped with signal " ++ show sig
oldHandler <- installHandler processStatusChanged (CatchInfo sigHandler) Nothing
- let withVarExprList (( name, expr ) : rest) act = do
- value <- evalSome expr
- local (fmap $ \s -> s { tsVars = ( name, value ) : tsVars s }) $ do
- withVarExprList rest act
- withVarExprList [] act = act
-
resetOutputTime out
res <- runExceptT $ flip runReaderT (tenv, tstate) $ fromTestRun $ do
- withVarExprList variables $ do
- withInternet $ \_ -> do
- evalBlock =<< eval (testSteps test)
- when (optWait opts) $ do
- void $ outPromptGetLine $ "Test '" <> testName test <> "' completed, waiting..."
+ withInternet $ \_ -> do
+ evalBlock =<< eval (testSteps test)
+ when (optWait opts) $ do
+ void $ outPromptGetLine $ "Test '" <> testName test <> "' completed, waiting..."
void $ installHandler processStatusChanged oldHandler Nothing
@@ -109,6 +104,11 @@ runTest out opts test variables = do
return True
_ -> return False
+
+evalGlobalDefs :: [ (( ModuleName, VarName ), SomeExpr ) ] -> GlobalDefs
+evalGlobalDefs exprs = fix $ \gdefs ->
+ builtins `M.union` M.fromList (map (fmap (evalSomeWith gdefs)) exprs)
+
evalBlock :: TestBlock -> TestRun ()
evalBlock (TestBlock steps) = forM_ steps $ \case
Subnet name parent inner -> do