[commit: ghc] wip/T16197: hWaitForInput-accurate-socket test (ce2f77d)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/T16197
Link       : http://ghc.haskell.org/trac/ghc/changeset/ce2f77d5656e847e8411805906f736a4a0a1242e/ghc

>---------------------------------------------------------------

commit ce2f77d5656e847e8411805906f736a4a0a1242e
Author: Tom Sydney Kerckhove <syd at cs-syd.eu>
Date:   Fri Dec 21 12:41:13 2018 +0200

    hWaitForInput-accurate-socket test


>---------------------------------------------------------------

ce2f77d5656e847e8411805906f736a4a0a1242e
 libraries/base/tests/all.T                         |  1 +
 .../base/tests/hWaitForInput-accurate-socket.hs    | 48 ++++++++++++++++++++++
 .../tests/hWaitForInput-accurate-socket.stdout     |  1 +
 3 files changed, 50 insertions(+)

diff --git a/libraries/base/tests/all.T b/libraries/base/tests/all.T
index aaf4aa2..457d9f4 100644
--- a/libraries/base/tests/all.T
+++ b/libraries/base/tests/all.T
@@ -200,6 +200,7 @@ test('T9681', normal, compile_fail, [''])
 test('T8089',
      [exit_code(99), run_timeout_multiplier(0.01)],
      compile_and_run, [''])
+test('hWaitForInput-accurate-socket', normal, compile_and_run, [''])
 test('T8684', expect_broken(8684), compile_and_run, [''])
 test('T9826',normal, compile_and_run,[''])
 test('T9848',
diff --git a/libraries/base/tests/hWaitForInput-accurate-socket.hs b/libraries/base/tests/hWaitForInput-accurate-socket.hs
new file mode 100644
index 0000000..ea3580e
--- /dev/null
+++ b/libraries/base/tests/hWaitForInput-accurate-socket.hs
@@ -0,0 +1,48 @@
+import Control.Concurrent
+import Control.Monad
+import Foreign.C
+import GHC.Clock
+import GHC.IO.Device
+import GHC.IO.Handle.FD
+import System.IO
+import System.Posix.IO
+import System.Posix.Types
+import System.Timeout
+
+main :: IO ()
+main = do
+    socketHandle <- makeTestSocketHandle
+    let nanoSecondsPerSecond = 1000 * 1000 * 1000
+    let milliSecondsPerSecond = 1000
+    let timeToSpend = 1
+    let timeToSpendNano = timeToSpend * nanoSecondsPerSecond
+    let timeToSpendMilli = timeToSpend * milliSecondsPerSecond
+    start <- getMonotonicTimeNSec
+    b <- hWaitForInput socketHandle 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)
+
+foreign import ccall unsafe "socket" c_socket ::
+               CInt -> CInt -> CInt -> IO CInt
+
+makeTestSocketHandle :: IO Handle
+makeTestSocketHandle = do
+    sockNum <-
+        c_socket
+            1 -- PF_LOCAL
+            2 -- SOCK_DGRAM
+            0
+    let fd = fromIntegral sockNum :: Fd
+    h <-
+        fdToHandle'
+            (fromIntegral fd)
+            (Just GHC.IO.Device.Stream)
+            True
+            "testsocket"
+            ReadMode
+            True
+    hSetBuffering h NoBuffering
+    pure h
diff --git a/libraries/base/tests/hWaitForInput-accurate-socket.stdout b/libraries/base/tests/hWaitForInput-accurate-socket.stdout
new file mode 100644
index 0000000..f1e939c
--- /dev/null
+++ b/libraries/base/tests/hWaitForInput-accurate-socket.stdout
@@ -0,0 +1 @@
+delta >= 0: True