ghc/tests/concurrent/should_run/conc018.hs

   1 import Concurrent
   2 import Exception
   3
   4 -- test that putMVar blocks on a full MVar rather than raising an
   5 -- exception.
   6
   7 main = do
   8   t <- forkIO (
   9             Exception.catch (do
  10                 m <- newMVar ()
  11                 putMVar m ()
  12              )
  13              (\e -> print e)
  14            )
  15   threadDelay 500000
  16   killThread t