diff options
author | Roman Smrž <roman.smrz@seznam.cz> | 2025-09-14 21:02:50 +0200 |
---|---|---|
committer | Roman Smrž <roman.smrz@seznam.cz> | 2025-09-15 21:11:01 +0200 |
commit | ed6d95dde5f12727cfa06b851c70b07cb415e9d6 (patch) | |
tree | 57056b70fc9930db23f29597004dd35fbb70fafc /src/Test.hs | |
parent | 8e3d03e55793b49dc6844b23877c84d111e8d7d1 (diff) |
Support zero timeout
Changelog: Support zero as a timeout multiplyer
Diffstat (limited to 'src/Test.hs')
-rw-r--r-- | src/Test.hs | 11 |
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)) |