ghc/tests/concurrent/should_run/conc012.hs

   1 module Main where
   2
   3 import Concurrent
   4 import Exception
   5
   6 data Result = Died Exception | Finished
   7
   8 -- Test stack overflow catching.  Should print "Died: stack overflow".
   9
  10 main = do
  11   let x = sum [1..100000]  -- relies on sum being implemented badly :-)
  12   result <- newEmptyMVar
  13   forkIO (catchAllIO (x `seq` putMVar result Finished)
  14                      (\e -> putMVar result (Died e)))
  15   res <- takeMVar result
  16   case res of
  17         Died e -> putStr ("Died: " ++ show e ++ "\n")
  18         Finished -> putStr "Ok.\n"