blob: d012ac6fe72b10cc09613372108afa637ceab6b8 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
|
{-# LANGUAGE BangPatterns #-}
module Main where
import Control.Concurrent
import Foreign.C
import GHC.Clock
import GHC.Event
import System.CPUTime
import System.Posix.Types
import Control.Monad
import System.Exit
foreign import ccall unsafe "socket" c_socket ::
CInt -> CInt -> CInt -> IO CInt
makeTestSocketFd :: IO Fd
makeTestSocketFd = do
sockNum <-
c_socket
1 -- PF_LOCAL
2 -- SOCK_DGRAM
0
return $ (fromIntegral sockNum :: Fd)
callback :: FdKey -> Event -> IO ()
callback _ _ = return ()
-- Idle CPU usage with 0 for 0% and 10^12 for 100%
idleCpuUsage :: IO Integer
idleCpuUsage = do
-- measure the process time spent in the rts, not in the mutator
-- make sure to disable idle GC (+RTS -I0)
!startCPUTime <- getCPUTime
threadDelay 100000
!endCPUTime <- getCPUTime
let !t = endCPUTime - startCPUTime
return $ t
main :: IO ()
main = do
(Just eventMgr) <- getSystemEventManager
fd <- makeTestSocketFd
let getAvgCpuUsage = do
let n = 10
let warmup = 2
xs <- drop warmup <$> replicateM (warmup+n) idleCpuUsage
return $! fromIntegral (sum xs) / fromIntegral n
!before <- getAvgCpuUsage
registerFd eventMgr callback fd evtRead OneShot
registerFd eventMgr callback fd evtWrite OneShot
-- use this to test that this test works
--forkIO $ forever $ do
-- putStrLn ""
-- threadDelay 10000
!after <- getAvgCpuUsage
-- CPU consumption should roughly be the same when just idling vs
-- when idling after the event has been triggered
let r = (after-before) / before * 100
let max_percent = 100 -- max difference (in percent)
when (abs r > max_percent) $ do
putStrLn $ mconcat
[ "Idle CPU consumption too different after event registration: "
, if r > 0 then "+" else ""
, show (round r)
, "% (> +/- "
, show (round max_percent)
, "%)\n"
, "Before: "
, show (round before `div` 1000000 :: Integer)
, "ms\n"
, "After: "
, show (round after `div` 1000000 :: Integer)
, "ms"
]
exitFailure
|
