summaryrefslogtreecommitdiff
path: root/testsuite/tests/rts/RestartEventLogging.hs
blob: 5c532895e88d209b03f887a888cadf199d0b5a6d (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
{-# LANGUAGE ForeignFunctionInterface #-}

import System.IO

import Control.Concurrent
import Control.Monad (forever, void)
import GHC.Conc


-- Test that the start/end/restartEventLog interface works as expected.
main :: IO ()
main = do

  --
  -- Start other threads to generate some event log events.
  --

  let loop f = void $ forkIO $ forever (f >> yield)

  -- start lots of short lived threads
  loop (forkIO $ yield)

  -- sparks
  loop (let x = 1 + (1 :: Int) in return (par x (sum [0,1,2,3,x])))

  --
  -- Try restarting event logging a few times.
  --

  putStrLn "Restarting eventlog..."
  hFlush stdout
  c_restart_eventlog

foreign import ccall safe "c_restart_eventlog"
  c_restart_eventlog :: IO ()