ghc-gc-hook-0.2.1.0: test/Main.hs

{-# 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