1 files changed, 29 insertions, 13 deletions
diff --git a/src/Run/Monad.hs b/src/Run/Monad.hs
index 3739e2e..f681e99 100644
--- a/src/Run/Monad.hs
+++ b/src/Run/Monad.hs
@@ -7,6 +7,7 @@ module Run.Monad (
 
     finally,
     forkTest,
+    forkTestUsing,
 ) where
 
 import Control.Concurrent
@@ -14,31 +15,41 @@ import Control.Concurrent.STM
 import Control.Monad
 import Control.Monad.Except
 import Control.Monad.Reader
+import Control.Monad.Writer
 
 import Data.Map (Map)
-import Data.Set (Set)
 import Data.Scientific
-import qualified Data.Text as T
+import Data.Set (Set)
+import Data.Text qualified as T
 
 import {-# SOURCE #-} GDB
 import Network.Ip
 import Output
 import {-# SOURCE #-} Process
-import Test
+import Script.Expr
+import Script.Object
 
-newtype TestRun a = TestRun { fromTestRun :: ReaderT (TestEnv, TestState) (ExceptT Failed IO) a }
-    deriving (Functor, Applicative, Monad, MonadReader (TestEnv, TestState), MonadIO)
+newtype TestRun a = TestRun { fromTestRun :: ReaderT (TestEnv, TestState) (ExceptT Failed (WriterT [ SomeObject TestRun ] IO)) a }
+  deriving
+    ( Functor, Applicative, Monad
+    , MonadReader ( TestEnv, TestState )
+    , MonadWriter [ SomeObject TestRun ]
+    , MonadIO
+    )
 
 data TestEnv = TestEnv
     { teOutput :: Output
     , teFailed :: TVar (Maybe Failed)
     , teOptions :: TestOptions
-    , teProcesses :: MVar [Process]
+    , teNextObjId :: MVar Int
+    , teProcesses :: MVar [ Process ]
+    , teTimeout :: MVar Scientific
     , teGDB :: Maybe (MVar GDB)
     }
 
 data TestState = TestState
-    { tsVars :: [(VarName, SomeVarValue)]
+    { tsGlobals :: GlobalDefs
+    , tsLocals :: [ ( VarName, SomeVarValue ) ]
     , tsDisconnectedUp :: Set NetworkNamespace
     , tsDisconnectedBridge :: Set NetworkNamespace
     , tsNodePacketLoss :: Map NetworkNamespace Scientific
@@ -91,8 +102,9 @@ instance MonadError Failed TestRun where
     catchError (TestRun act) handler = TestRun $ catchError act $ fromTestRun . handler
 
 instance MonadEval TestRun where
-    askDictionary = asks (tsVars . snd)
-    withDictionary f = local (fmap $ \s -> s { tsVars = f (tsVars s) })
+    askGlobalDefs = asks (tsGlobals . snd)
+    askDictionary = asks (tsLocals . snd)
+    withDictionary f = local (fmap $ \s -> s { tsLocals = f (tsLocals s) })
 
 instance MonadOutput TestRun where
     getOutput = asks $ teOutput . fst
@@ -107,10 +119,14 @@ finally act handler = do
     void handler
     return x
 
-forkTest :: TestRun () -> TestRun ()
-forkTest act = do
+forkTest :: TestRun () -> TestRun ThreadId
+forkTest = forkTestUsing forkIO
+
+forkTestUsing :: (IO () -> IO ThreadId) -> TestRun () -> TestRun ThreadId
+forkTestUsing fork act = do
     tenv <- ask
-    void $ liftIO $ forkIO $ do
-        runExceptT (flip runReaderT tenv $ fromTestRun act) >>= \case
+    liftIO $ fork $ do
+        ( res, [] ) <- runWriterT (runExceptT $ flip runReaderT tenv $ fromTestRun act)
+        case res of
             Left e -> atomically $ writeTVar (teFailed $ fst tenv) (Just e)
             Right () -> return ()