summaryrefslogtreecommitdiff
path: root/src/Test.hs
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2025-09-14 21:02:50 +0200
committerRoman Smrž <roman.smrz@seznam.cz>2025-09-15 21:11:01 +0200
commited6d95dde5f12727cfa06b851c70b07cb415e9d6 (patch)
tree57056b70fc9930db23f29597004dd35fbb70fafc /src/Test.hs
parent8e3d03e55793b49dc6844b23877c84d111e8d7d1 (diff)
Support zero timeout
Changelog: Support zero as a timeout multiplyer
Diffstat (limited to 'src/Test.hs')
-rw-r--r--src/Test.hs11
1 files changed, 7 insertions, 4 deletions
diff --git a/src/Test.hs b/src/Test.hs
index ce88052..18933b1 100644
--- a/src/Test.hs
+++ b/src/Test.hs
@@ -10,6 +10,7 @@ import Control.Concurrent.MVar
import Control.Monad.Except
import Control.Monad.Reader
+import Data.Bifunctor
import Data.Scientific
import Data.Text (Text)
import Data.Typeable
@@ -67,15 +68,17 @@ instance ObjectType TestRun MultiplyTimeout where
type ConstructorArgs MultiplyTimeout = Scientific
createObject oid timeout
- | timeout > 0 = do
+ | timeout >= 0 = do
var <- asks (teTimeout . fst)
- liftIO $ modifyMVar_ var $ return . (* timeout)
+ liftIO $ modifyMVar_ var $ return .
+ (if timeout == 0 then second (+ 1) else first (* timeout))
return $ Object oid $ MultiplyTimeout timeout
| otherwise = do
- outLine OutputError Nothing "timeout must be positive"
+ outLine OutputError Nothing "timeout must not be negative"
throwError Failed
destroyObject Object { objImpl = MultiplyTimeout timeout } = do
var <- asks (teTimeout . fst)
- liftIO $ modifyMVar_ var $ return . (/ timeout)
+ liftIO $ modifyMVar_ var $ return .
+ (if timeout == 0 then second (subtract 1) else first (/ timeout))