1 files changed, 22 insertions, 4 deletions
diff --git a/src/Run/Monad.hs b/src/Run/Monad.hs
index abef32d..c742987 100644
--- a/src/Run/Monad.hs
+++ b/src/Run/Monad.hs
@@ -8,6 +8,8 @@ module Run.Monad (
     finally,
     forkTest,
     forkTestUsing,
+
+    getCurrentTimeout,
 ) where
 
 import Control.Concurrent
@@ -15,6 +17,7 @@ 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.Scientific
@@ -26,15 +29,23 @@ import Network.Ip
 import Output
 import {-# SOURCE #-} Process
 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, Integer ) -- ( positive timeout, number of zero multiplications )
     , teGDB :: Maybe (MVar GDB)
     }
 
@@ -117,6 +128,13 @@ forkTestUsing :: (IO () -> IO ThreadId) -> TestRun () -> TestRun ThreadId
 forkTestUsing fork act = do
     tenv <- ask
     liftIO $ fork $ do
-        runExceptT (flip runReaderT tenv $ fromTestRun act) >>= \case
+        ( res, [] ) <- runWriterT (runExceptT $ flip runReaderT tenv $ fromTestRun act)
+        case res of
             Left e -> atomically $ writeTVar (teFailed $ fst tenv) (Just e)
             Right () -> return ()
+
+getCurrentTimeout :: TestRun Scientific
+getCurrentTimeout = do
+    ( timeout, zeros ) <- liftIO . readMVar =<< asks (teTimeout . fst)
+    return $ if zeros > 0 then 0
+                          else timeout