Commit 3825b7e2 authored by Tom Sydney Kerckhove's avatar Tom Sydney Kerckhove Committed by Tamar Christina
Browse files

Remove the 'legroom' part of the timeout-accurate-pure test.

Summary:
This removes the part of the test that checks whether the timeout happened in
a 'reasonable' amount of time, because it is flaky.
In subsequent work, we can turn this into a benchmark.

Test Plan: This _is_ a test

Reviewers: nh2, bgamari, Phyx, austin, hvr

Reviewed By: Phyx

Subscribers: rwbarton, thomie

GHC Trac Issues: #8684

Differential Revision: https://phabricator.haskell.org/D4120
parent 8843a39b
...@@ -190,7 +190,6 @@ test('T8089', ...@@ -190,7 +190,6 @@ test('T8089',
[exit_code(99), run_timeout_multiplier(0.01)], [exit_code(99), run_timeout_multiplier(0.01)],
compile_and_run, ['']) compile_and_run, [''])
test('T8684', expect_broken(8684), 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('T9826',normal, compile_and_run,[''])
test('T9848', test('T9848',
[ stats_num_field('bytes allocated', [ stats_num_field('bytes allocated',
......
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)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment