[commit: ghc] wip/T13633, wip/non-det-ci: hWaitForInput-accurate-socket test (2e9426d)
git at git.haskell.org
git at git.haskell.org
Sun Feb 24 20:54:41 UTC 2019
Repository : ssh://git@git.haskell.org/ghc
On branches: wip/T13633,wip/non-det-ci
Link : http://ghc.haskell.org/trac/ghc/changeset/2e9426df902cd2e118f162876d6991ffa5be9137/ghc
>---------------------------------------------------------------
commit 2e9426df902cd2e118f162876d6991ffa5be9137
Author: Tom Sydney Kerckhove <syd at cs-syd.eu>
Date: Fri Dec 21 12:35:32 2018 +0200
hWaitForInput-accurate-socket test
>---------------------------------------------------------------
2e9426df902cd2e118f162876d6991ffa5be9137
libraries/base/tests/all.T | 1 +
.../base/tests/hWaitForInput-accurate-pipe.hs | 23 ++++++++++++++++++++++
...t.stdout => hWaitForInput-accurate-pipe.stdout} | 0
3 files changed, 24 insertions(+)
diff --git a/libraries/base/tests/all.T b/libraries/base/tests/all.T
index 25e851b..dc16246 100644
--- a/libraries/base/tests/all.T
+++ b/libraries/base/tests/all.T
@@ -203,6 +203,7 @@ test('T8089',
test('hWaitForInput-accurate-socket', reqlib('unix'), compile_and_run, [''])
test('T8684', expect_broken(8684), compile_and_run, [''])
test('hWaitForInput-accurate-stdin', normal, compile_and_run, [''])
+test('hWaitForInput-accurate-pipe', reqlib('unix'), compile_and_run, [''])
test('T9826',normal, compile_and_run,[''])
test('T9848',
[ collect_stats('bytes allocated')
diff --git a/libraries/base/tests/hWaitForInput-accurate-pipe.hs b/libraries/base/tests/hWaitForInput-accurate-pipe.hs
new file mode 100644
index 0000000..409c60c
--- /dev/null
+++ b/libraries/base/tests/hWaitForInput-accurate-pipe.hs
@@ -0,0 +1,23 @@
+import Control.Concurrent
+import Control.Monad
+import GHC.Clock
+import System.IO
+import System.Posix.IO
+import System.Timeout
+
+main :: IO ()
+main = do
+ (readPipe, _) <- createPipe
+ readPipeHandle <- fdToHandle readPipe
+ let nanoSecondsPerSecond = 1000 * 1000 * 1000
+ let milliSecondsPerSecond = 1000
+ let timeToSpend = 1
+ let timeToSpendNano = timeToSpend * nanoSecondsPerSecond
+ let timeToSpendMilli = timeToSpend * milliSecondsPerSecond
+ start <- getMonotonicTimeNSec
+ b <- hWaitForInput readPipeHandle timeToSpendMilli
+ end <- getMonotonicTimeNSec
+ let timeSpentNano = fromIntegral $ end - start
+ let delta = timeSpentNano - timeToSpendNano
+ -- We can never wait for a shorter amount of time than specified
+ putStrLn $ "delta >= 0: " ++ show (delta > 0)
diff --git a/libraries/base/tests/hWaitForInput-accurate-socket.stdout b/libraries/base/tests/hWaitForInput-accurate-pipe.stdout
similarity index 100%
copy from libraries/base/tests/hWaitForInput-accurate-socket.stdout
copy to libraries/base/tests/hWaitForInput-accurate-pipe.stdout
More information about the ghc-commits
mailing list