blob: ead85a530d9b6e3a6cfc7395307e44ac3bf2499b (
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 #-}
{-# OPTIONS -cpp #-}
module Main where
import Control.Concurrent
import Control.Exception
import Prelude hiding (catch)
import Foreign
import System.IO
#ifdef mingw32_HOST_OS
sleep n = sleepBlock (n*1000)
foreign import stdcall unsafe "Sleep" sleepBlock :: Int -> IO ()
#else
sleep n = sleepBlock n
foreign import ccall unsafe "sleep" sleepBlock :: Int -> IO ()
#endif
main :: IO ()
main = do
newStablePtr stdout -- prevent stdout being finalized, sigh
th <- newEmptyMVar
forkIO $ do
putStrLn "newThread started"
sleep 1
putMVar th "child"
threadDelay 500000
yield -- another hack, just in case child yields right after "sleep 1"
putMVar th "main" `catch` (\BlockedIndefinitelyOnMVar -> return ())
-- tests that the other thread doing an unsafe call to
-- sleep(3) has blocked this thread. Not sure if this
-- is a useful test.
x <- takeMVar th
putStrLn x
putStrLn "\nshutting down"
|
