Commit ce2f77d5 authored by Tom Sydney Kerckhove's avatar Tom Sydney Kerckhove Committed by Ben Gamari

hWaitForInput-accurate-socket test

parent 36e3e747
......@@ -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',
......
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
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