summaryrefslogtreecommitdiff
path: root/testsuite/tests/concurrent/should_run/async001.hs
blob: 7d765e26f95cae4e830a467c27f96b66af8425f4 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
import Control.Exception as E
import Control.Concurrent
import System.IO.Unsafe

-- x is killed during evaluation with an asynchronous exception, but
-- nevertheless gets overwritten with 'throw ThreadKilled' because the
-- async exception is re-thrown as a synchrnonous exception by
-- 'onException'.

main = do
  let x = unsafePerformIO $ 
             (do threadDelay 1000000; return 42)
             `onException` return ()

  t <- forkIO $ do evaluate x; return ()
  threadDelay 1000
  killThread t

  print x `E.catch` \e -> putStrLn ("main caught: " ++ show (e::SomeException))