Commit 986643cb authored by Ivan Kasatenko's avatar Ivan Kasatenko Committed by Ben Gamari

Fix T16916 CI failures (#16966)

1. Slightly increased the waiting time for the tested effect to be more
   profound.

2. Introduced measuring of the actual time spent waiting and adjusing
   CPU time by it to compensate for threadDelay waiting time
   inconsistencies.
parent 5e04841c
...@@ -2,6 +2,7 @@ module Main where ...@@ -2,6 +2,7 @@ module Main where
import Control.Concurrent import Control.Concurrent
import Foreign.C import Foreign.C
import GHC.Clock
import GHC.Event import GHC.Event
import System.CPUTime import System.CPUTime
import System.Posix.Types import System.Posix.Types
...@@ -21,12 +22,15 @@ makeTestSocketFd = do ...@@ -21,12 +22,15 @@ makeTestSocketFd = do
callback :: FdKey -> Event -> IO () callback :: FdKey -> Event -> IO ()
callback _ _ = return () callback _ _ = return ()
idleCpuUsage :: IO Integer -- Idle CPU usage with 0 for 0% and 10^12 for 100%
idleCpuUsage :: IO Double
idleCpuUsage = do idleCpuUsage = do
startTime <- getMonotonicTime
startCPUTime <- getCPUTime startCPUTime <- getCPUTime
threadDelay 500000 threadDelay 1000000
endCPUTime <- getCPUTime endCPUTime <- getCPUTime
return $ endCPUTime - startCPUTime endTime <- getMonotonicTime
return $ fromIntegral (endCPUTime - startCPUTime) / (endTime - startTime)
main :: IO () main :: IO ()
main = do main = do
...@@ -42,4 +46,4 @@ main = do ...@@ -42,4 +46,4 @@ main = do
-- CPU consumption should roughly be the same when just idling vs -- CPU consumption should roughly be the same when just idling vs
-- when idling after the event been triggered -- when idling after the event been triggered
print $ (fromIntegral eventTriggeredUsage / fromIntegral noEventUsage) < 2.0 print $ eventTriggeredUsage / noEventUsage < 2.0
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