ghc/tests/concurrent/should_run/conc014.hs

   1 import Concurrent
   2 import Exception
   3
   4 -- Test blocking of async exceptions in an exception handler.
   5 -- The exception raised in the main thread should not be delivered
   6 -- until the first exception handler finishes.
   7 main = do
   8   main_thread <- myThreadId
   9   m <- newEmptyMVar
  10   forkIO (do { takeMVar m;  raiseInThread main_thread (ErrorCall "foo") })
  11   (error "wibble")
  12         `catchAllIO` (\e -> do putMVar m ()
  13                                sum [1..10000] `seq` putStrLn "done.")
  14   (threadDelay 500000)
  15         `catchAllIO` (\e -> putStrLn ("caught: " ++ show e))
  16