1 files changed, 49 insertions, 0 deletions
diff --git a/testsuite/tests/concurrent/should_run/conc035.hs b/testsuite/tests/concurrent/should_run/conc035.hs
new file mode 100644
index 0000000000..fcb2d5c2e4
--- /dev/null
+++ b/testsuite/tests/concurrent/should_run/conc035.hs
@@ -0,0 +1,49 @@
+module Main where
+
+import Control.Concurrent
+import qualified Control.Exception as E
+
+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 caughtVar)
+
+trapExc :: MVar Int -> MVar () -> E.SomeException -> IO ()
+-- If we have been killed then we are done
+trapExc inVar caughtVar  e
+  | Just E.ThreadKilled <- E.fromException e  = return ()
+-- Otherwise...
+trapExc inVar caughtVar e =
+  do putStrLn ("Exception: " ++ show e)
+     putMVar caughtVar ()
+     trapHandler inVar caughtVar
+
+main :: IO ()
+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
+  -- Running the GHCi way complains that tid is blocked indefinitely if
+  -- it still exists, so kill it.
+  killThread tid
+  putStrLn "All done"