summaryrefslogtreecommitdiff
path: root/test/Main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'test/Main.hs')
-rw-r--r--test/Main.hs38
1 files changed, 33 insertions, 5 deletions
diff --git a/test/Main.hs b/test/Main.hs
index c813e48..aad5ebb 100644
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -1,14 +1,42 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
module Main where
-import Control.Monad (forM_)
+import Control.Monad (forM_, when)
+import qualified System.Clock as Clock
+import Foreign.Ptr (Ptr)
import GHC.GC_Hook
-main :: IO ()
-main = do
- setGCHook
+foreign import ccall "get_my_delegate_ptr" c_get_my_delegate_ptr :: IO (Ptr ())
+
+
+{-# NOINLINE invokeGCsometimes #-}
+invokeGCsometimes :: IO ()
+invokeGCsometimes =
forM_ [1..10] $ \i -> do
let l = [i..10000]
print (sum l + product l + length l)
- getGCLog >>= print
+
+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