summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSylvain Henry <sylvain@haskus.fr>2021-01-22 16:32:09 +0100
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-01-27 17:43:05 -0500
commit9c87f97ee9e697b6609db892a503fc053dc8f901 (patch)
tree200ec4a8978ee0e22c59d8358c4b319d060feb00
parent614cb0690afc8a54104cc95e41b91d68b330b707 (diff)
downloadhaskell-9c87f97ee9e697b6609db892a503fc053dc8f901.tar.gz
Fix spurious failures of T16916 on CI (#16966)
* disable idle GC which has a big impact on time measures * use average measures (before and after event registration) * use warmup measures (for some reason the first measure of a batch seems to be often quite different from the others) * drop the division by monotonic clock time: this clock is impacted by the load of the runner. We only want to measure the time spent in the RTS while the mutator is idle so I don't understand why it was used.
-rw-r--r--testsuite/tests/lib/base/T16916.hs56
-rw-r--r--testsuite/tests/lib/base/T16916.stdout1
-rw-r--r--testsuite/tests/lib/base/all.T2
3 files changed, 46 insertions, 13 deletions
diff --git a/testsuite/tests/lib/base/T16916.hs b/testsuite/tests/lib/base/T16916.hs
index 267f0c5760..d012ac6fe7 100644
--- a/testsuite/tests/lib/base/T16916.hs
+++ b/testsuite/tests/lib/base/T16916.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE BangPatterns #-}
module Main where
import Control.Concurrent
@@ -6,6 +7,8 @@ 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
@@ -23,27 +26,58 @@ callback :: FdKey -> Event -> IO ()
callback _ _ = return ()
-- Idle CPU usage with 0 for 0% and 10^12 for 100%
-idleCpuUsage :: IO Double
+idleCpuUsage :: IO Integer
idleCpuUsage = do
- startTime <- getMonotonicTime
- startCPUTime <- getCPUTime
- threadDelay 5000000
- endCPUTime <- getCPUTime
- endTime <- getMonotonicTime
- return $ fromIntegral (endCPUTime - startCPUTime) / (endTime - startTime)
+ -- 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
- noEventUsage <- idleCpuUsage
+ 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
- eventTriggeredUsage <- idleCpuUsage
+ -- 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 been triggered
- print $ eventTriggeredUsage / noEventUsage < 100.0
+ -- 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
diff --git a/testsuite/tests/lib/base/T16916.stdout b/testsuite/tests/lib/base/T16916.stdout
deleted file mode 100644
index 0ca95142bb..0000000000
--- a/testsuite/tests/lib/base/T16916.stdout
+++ /dev/null
@@ -1 +0,0 @@
-True
diff --git a/testsuite/tests/lib/base/all.T b/testsuite/tests/lib/base/all.T
index f6770cf91a..695b60b51c 100644
--- a/testsuite/tests/lib/base/all.T
+++ b/testsuite/tests/lib/base/all.T
@@ -1,4 +1,4 @@
test('T16586', normal, compile_and_run, ['-O2'])
# Event-manager not supported on Windows
-test('T16916', when(opsys('mingw32'), skip), compile_and_run, ['-O2 -threaded'])
+test('T16916', when(opsys('mingw32'), skip), compile_and_run, ['-O2 -threaded -with-rtsopts="-I0" -rtsopts'])
test('T17310', normal, compile, [''])