ghc/tests/concurrent/should_run/conc016.hs

   1 import Concurrent
   2 import Exception
   3
   4 -- check that we can still kill a thread that is blocked on
   5 -- delivering an exception to us.
   6 main = do
   7   main_thread <- myThreadId
   8   m <- newEmptyMVar
   9   sub_thread <- forkIO (do
  10                          takeMVar m
  11                          throwTo main_thread (ErrorCall "foo")
  12                         )
  13   block (do
  14     putMVar m ()
  15     sum [1..10000] `seq` -- to be sure the other thread is now blocked
  16       killThread sub_thread
  17    )
  18   putStrLn "ok"