Commit 8eceeddb authored by simonmar's avatar simonmar
Browse files

[project @ 1999-12-01 16:14:56 by simonmar]

Add some tests for the new async exception behaviour.
parent 58d28d4e
import Concurrent
import Exception
-- Test blocking of async exceptions in an exception handler.
-- The exception raised in the main thread should not be delivered
-- until the first exception handler finishes.
main = do
main_thread <- myThreadId
m <- newEmptyMVar
forkIO (do { takeMVar m; raiseInThread main_thread (ErrorCall "foo") })
(error "wibble")
`catchAllIO` (\e -> do putMVar m ()
threadDelay 500000
putStrLn "done.")
(threadDelay 500000)
`catchAllIO` (\e -> putStrLn ("caught: " ++ show e))
import Concurrent
import Exception
-- test blocking & unblocking of async exceptions.
-- the first exception "foo" should be caught by the "caught1" handler,
-- since async exceptions are blocked outside this handler.
-- the second exception "bar" should be caught by the outer "caught2" handler,
-- (i.e. this tests that async exceptions are properly unblocked after
-- being blocked).
main = do
main_thread <- myThreadId
m <- newEmptyMVar
m2 <- newEmptyMVar
forkIO (do takeMVar m
raiseInThread main_thread (ErrorCall "foo")
raiseInThread main_thread (ErrorCall "bar")
putMVar m2 ()
)
( do
blockAsyncExceptions (do
putMVar m ()
threadDelay 500000
(unblockAsyncExceptions (threadDelay 500000))
`catchAllIO` (\e -> putStrLn ("caught1: " ++ show e))
)
takeMVar m2
)
`catchAllIO`
(\e -> putStrLn ("caught2: " ++ show e))
import Concurrent
import Exception
-- check that we can still kill a thread that is blocked on
-- delivering an exception to us.
main = do
main_thread <- myThreadId
m <- newEmptyMVar
sub_thread <- forkIO (do
takeMVar m
raiseInThread main_thread (ErrorCall "foo")
)
blockAsyncExceptions (do
putMVar m ()
threadDelay 500000 -- to be sure the other thread is now blocked
killThread sub_thread
)
putStrLn "ok"
import Concurrent
import 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
raiseInThread main_thread (ErrorCall "foo")
takeMVar m2
raiseInThread main_thread (ErrorCall "bar")
putMVar m3 ()
)
(do
blockAsyncExceptions (do
(do putMVar m1 ()
unblockAsyncExceptions (
-- unblocked, "foo" delivered to "caught1"
threadDelay 100000
)
) `catchAllIO` (\e -> putStrLn ("caught1: " ++ show e))
putMVar m2 ()
-- blocked here, "bar" can't be delivered
(threadDelay 100000)
`catchAllIO` (\e -> putStrLn ("caught2: " ++ show e))
)
-- unblocked here, "bar" delivered to "caught3"
takeMVar m3
)
`catchAllIO` (\e -> putStrLn ("caught3: " ++ show e))
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment