From ed6d95dde5f12727cfa06b851c70b07cb415e9d6 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Sun, 14 Sep 2025 21:02:50 +0200
Subject: Support zero timeout

Changelog: Support zero as a timeout multiplyer
---
 src/Run/Monad.hs | 10 +++++++++-
 1 file changed, 9 insertions(+), 1 deletion(-)

(limited to 'src/Run/Monad.hs')

diff --git a/src/Run/Monad.hs b/src/Run/Monad.hs
index f681e99..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
@@ -43,7 +45,7 @@ data TestEnv = TestEnv
     , teOptions :: TestOptions
     , teNextObjId :: MVar Int
     , teProcesses :: MVar [ Process ]
-    , teTimeout :: MVar Scientific
+    , teTimeout :: MVar ( Scientific, Integer ) -- ( positive timeout, number of zero multiplications )
     , teGDB :: Maybe (MVar GDB)
     }
 
@@ -130,3 +132,9 @@ forkTestUsing fork act = do
         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
-- 
cgit v1.2.3