blob: 81e6cc957e1c532342dbe079e5eb2077bc6b2e5e (
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
36
|
-- The same as T5611 but with unsafe calls.
{-# LANGUAGE CPP,ForeignFunctionInterface #-}
import Control.Concurrent
import Foreign.C
import System.IO
#if defined(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
hSetBuffering stdout LineBuffering
tid <- forkIO $ do
putStrLn "child: Sleeping"
_ <- sleep 1
-- The following lines should not happen after the killThread from the
-- parent thread completes. However, they do...
-- putStrLn "child: Done sleeping"
threadDelay 100000
putStrLn "child: Done waiting"
threadDelay 100000
-- putStrLn $ "parent: Throwing exception to thread " ++ show tid
throwTo tid $ userError "Exception delivered successfully"
putStrLn "parent: Done throwing exception"
threadDelay 200000
|
