diff options
Diffstat (limited to 'test')
-rw-r--r-- | test/Main.hs | 38 | ||||
-rw-r--r-- | test/cbits/testhook.c | 10 |
2 files changed, 43 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 diff --git a/test/cbits/testhook.c b/test/cbits/testhook.c new file mode 100644 index 0000000..47a774a --- /dev/null +++ b/test/cbits/testhook.c @@ -0,0 +1,10 @@ +#include "Rts.h" +#include <stdio.h> + +static void my_delegate_function(const struct GCDetails_ *d) { + printf("Yup test delegate hook worked\n"); +} + +void* get_my_delegate_ptr(void) { + return my_delegate_function; +} |