blob: 90e5f904eb69f7b493d76324f56fd5cccb218d44 (
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
|
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE TemplateHaskell #-}
module Main where
import Control.Monad (forM_, when)
import qualified System.Clock as Clock
import Foreign.Ptr (Ptr)
import GHC.GC_Hook
foreign import ccall "get_my_delegate_ptr" c_get_my_delegate_ptr :: IO (Ptr ())
$(return [])
{-# NOINLINE invokeGCsometimes #-}
invokeGCsometimes :: IO ()
invokeGCsometimes =
forM_ [1..10] $ \i -> do
let l = [i..10000]
print (sum l + product l + length l)
main :: IO ()
main = do
setGCHook
invokeGCsometimes
enabletm <- Clock.getTime Clock.Monotonic
enableGClogging True
invokeGCsometimes
gclog <- getGCLog
when (length gclog == 0) $
fail "GC log was unexpectedly empty"
when (any ((< enabletm) . detTimestamp) gclog) $ do
_ <- fail "Logging was already on before enableGClogging"
print enabletm
putStrLn "--"
mapM_ print (map detTimestamp gclog)
c_get_my_delegate_ptr >>= gcSetHookDelegate
invokeGCsometimes
|