summaryrefslogtreecommitdiff
path: root/testsuite/tests/rts/pause-resume/shouldfail/rts_lock_when_paused.hs
blob: 7ca1107211a10040a4adbd4b27965ce3eb83e5ad (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
{-# LANGUAGE ForeignFunctionInterface #-}

import Control.Concurrent
import Foreign
import Foreign.C
import System.Exit
import System.Timeout

foreign import ccall safe "rts_pause_lock.h assertDoneAfterOneSecond"
    safe_assertDoneAfterOneSecond_c :: Ptr CInt -> IO ()

foreign import ccall safe "rts_pause_lock.h lockThenPause"
    safe_lockThenPause_c :: Ptr CInt -> IO ()

main :: IO ()
main = alloca $ \donePtr -> do
  -- We don't expect a deadlock, but we want to avoid one in the case of a
  -- failed test.
  poke donePtr 0
  forkIO $ safe_assertDoneAfterOneSecond_c donePtr

  -- The actual test.
  safe_lockThenPause_c donePtr