ghc/tests/concurrent/should_run/conc015.hs

   1 import Concurrent
   2 import Exception
   3
   4 -- test blocking & unblocking of async exceptions.
   5
   6 -- the first exception "foo" should be caught by the "caught1" handler,
   7 -- since async exceptions are blocked outside this handler.
   8
   9 -- the second exception "bar" should be caught by the outer "caught2" handler,
  10 -- (i.e. this tests that async exceptions are properly unblocked after
  11 -- being blocked).
  12
  13 main = do
  14   main_thread <- myThreadId
  15   m <- newEmptyMVar
  16   m2 <- newEmptyMVar
  17   forkIO (do takeMVar m
  18              throwTo main_thread (ErrorCall "foo")
  19              throwTo main_thread (ErrorCall "bar")
  20              putMVar m2 ()
  21          )
  22   ( do
  23     block (do
  24         putMVar m ()
  25         sum [1..10000] `seq` -- give 'foo' a chance to be raised
  26           (unblock (threadDelay 500000))
  27                 `Exception.catch` (\e -> putStrLn ("caught1: " ++ show e))
  28      )
  29     takeMVar m2
  30    )
  31     `Exception.catch`
  32     (\e -> putStrLn ("caught2: " ++ show e))