blob: ad015f741377c24dd70644847ce5ccbacef00894 (
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
37
38
39
40
41
42
43
44
|
import Control.Concurrent
import Control.Exception
-- check that async exceptions are restored to their previous
-- state after an exception is raised and handled.
main = do
main_thread <- myThreadId
m1 <- newEmptyMVar
m2 <- newEmptyMVar
m3 <- newEmptyMVar
forkIO (do
takeMVar m1
throwTo main_thread (ErrorCall "foo")
takeMVar m2
throwTo main_thread (ErrorCall "bar")
putMVar m3 ()
)
(do
mask $ \restore -> do
(do putMVar m1 ()
restore (
-- unblocked, "foo" delivered to "caught1"
myDelay 100000
)
) `Control.Exception.catch`
\e -> putStrLn ("caught1: " ++ show (e::SomeException))
putMVar m2 ()
-- blocked here, "bar" can't be delivered
(sum [1..10000] `seq` return ())
`Control.Exception.catch`
\e -> putStrLn ("caught2: " ++ show (e::SomeException))
-- unblocked here, "bar" delivered to "caught3"
takeMVar m3
)
`Control.Exception.catch`
\e -> putStrLn ("caught3: " ++ show (e::SomeException))
-- compensate for the fact that threadDelay is non-interruptible
-- on Windows with the threaded RTS in 6.6.
myDelay usec = do
m <- newEmptyMVar
forkIO $ do threadDelay usec; putMVar m ()
takeMVar m
|
