diff options
| -rw-r--r-- | libraries/base/tests/all.T | 1 | ||||
| -rw-r--r-- | libraries/base/tests/timeout-accurate-pure.hs | 28 | ||||
| -rw-r--r-- | libraries/base/tests/timeout-accurate-pure.stdout | 2 |
3 files changed, 31 insertions, 0 deletions
diff --git a/libraries/base/tests/all.T b/libraries/base/tests/all.T index 9055bd5b45..a1eba6a465 100644 --- a/libraries/base/tests/all.T +++ b/libraries/base/tests/all.T @@ -190,6 +190,7 @@ test('T8089', [exit_code(99), run_timeout_multiplier(0.01)], compile_and_run, ['']) test('T8684', expect_broken(8684), compile_and_run, ['']) +test('timeout-accurate-pure', normal, compile_and_run, ['']) test('T9826',normal, compile_and_run,['']) test('T9848', [ stats_num_field('bytes allocated', diff --git a/libraries/base/tests/timeout-accurate-pure.hs b/libraries/base/tests/timeout-accurate-pure.hs new file mode 100644 index 0000000000..a59e785a01 --- /dev/null +++ b/libraries/base/tests/timeout-accurate-pure.hs @@ -0,0 +1,28 @@ +import Control.Concurrent +import Control.Monad +import GHC.Clock +import System.IO +import System.Timeout + +ack :: Integer -> Integer -> Integer +ack 0 n = n + 1 +ack m 0 = ack (m - 1) 1 +ack m n = ack (m - 1) (ack m (n - 1)) + +main :: IO () +main = do + let microsecondsPerSecond = 1000 * 1000 + let timeToSpend = 1 * microsecondsPerSecond -- One second in microseconds + start <- getMonotonicTimeNSec + timeout timeToSpend $ + -- Something that is guaranteed not to be done in 'timeToSpend' + print $ ack 4 2 + end <- getMonotonicTimeNSec + let timeSpentNano = fromIntegral $ end - start -- in nanoseconds + let nanosecondsPerMicrosecond = 1000 + let timeToSpendNano = timeToSpend * nanosecondsPerMicrosecond + let legRoom = 1 * 1000 * nanosecondsPerMicrosecond -- Nanoseconds + let delta = timeSpentNano - timeToSpendNano + -- We can never wait for a shorter amount of time than specified + putStrLn $ "delta > 0: " ++ show (delta > 0) + putStrLn $ "delta < legroom: " ++ show (delta < legRoom) diff --git a/libraries/base/tests/timeout-accurate-pure.stdout b/libraries/base/tests/timeout-accurate-pure.stdout new file mode 100644 index 0000000000..90f4a4c7e8 --- /dev/null +++ b/libraries/base/tests/timeout-accurate-pure.stdout @@ -0,0 +1,2 @@ +delta > 0: True +delta < legroom: True |