Commit 644c1ae4 authored by Simon Marlow's avatar Simon Marlow
Browse files

fix this test to work propertly with -threaded

parent 16aa8f7e
......@@ -3,34 +3,40 @@ module Main where
import Control.Concurrent
import qualified Control.Exception as E
trapHandler :: MVar Int -> IO ()
trapHandler inVar =
(do { trapMsg <- takeMVar inVar
; putStrLn ("Handler got: " ++ show trapMsg)
; trapHandler inVar
}
trapHandler :: MVar Int -> MVar () -> IO ()
trapHandler inVar caughtVar =
(do E.block $ do
trapMsg <- takeMVar inVar
putStrLn ("Handler got: " ++ show trapMsg)
trapHandler inVar caughtVar
)
`E.catch`
(trapExc inVar)
(trapExc inVar caughtVar)
trapExc :: MVar Int -> E.Exception -> IO ()
trapExc inVar e =
do { putStrLn ("Exception: " ++ show e)
; trapHandler inVar
}
trapExc :: MVar Int -> MVar () -> E.Exception -> IO ()
trapExc inVar caughtVar e =
do putStrLn ("Exception: " ++ show e)
putMVar caughtVar ()
trapHandler inVar caughtVar
main :: IO ()
main =
do { inVar <- newEmptyMVar
; tid <- forkIO (trapHandler inVar)
; yield
; putMVar inVar 1
; threadDelay 1000
; throwTo tid (E.ErrorCall "1st")
; threadDelay 1000
; putMVar inVar 2
; threadDelay 1000
; throwTo tid (E.ErrorCall "2nd")
; threadDelay 1000
; putStrLn "All done"
}
main = do
inVar <- newEmptyMVar
caughtVar <- newEmptyMVar
tid <- forkIO (trapHandler inVar caughtVar)
yield
putMVar inVar 1
threadDelay 1000
throwTo tid (E.ErrorCall "1st")
takeMVar caughtVar
putMVar inVar 2
threadDelay 1000
throwTo tid (E.ErrorCall "2nd")
-- the second time around, exceptions will be blocked, because
-- the trapHandler is effectively "still in the handler" from the
-- first exception. I'm not sure if this is by design or by
-- accident. Anyway, the trapHandler will at some point block
-- in takeMVar, and thereby become interruptible, at which point
-- it will receive the second exception.
takeMVar caughtVar
putStrLn "All done"
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment