diff options
author | Roman Smrž <roman.smrz@seznam.cz> | 2025-02-15 20:38:39 +0100 |
---|---|---|
committer | Roman Smrž <roman.smrz@seznam.cz> | 2025-02-24 21:43:09 +0100 |
commit | 3640256e80ba1aa1c1e022a231234dee814ace58 (patch) | |
tree | 4fa2fa9c97ceb54bcabd5136f47b70412ac0dbb4 /src/Run.hs | |
parent | 14efffc66cb60465c18c984311bde5a5502803db (diff) |
Collect and evaluate global definitions together
Diffstat (limited to 'src/Run.hs')
-rw-r--r-- | src/Run.hs | 28 |
1 files changed, 14 insertions, 14 deletions
@@ -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 |