From 5a888827c14dcbf279c986531cf8a6e8ee19eef1 Mon Sep 17 00:00:00 2001 From: Bas van Dijk Date: Mon, 29 Mar 2010 13:15:49 +0000 Subject: [PATCH] runInUnboundThread: block asynchronous exceptions before installing exception handler --- Control/Concurrent.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/Control/Concurrent.hs b/Control/Concurrent.hs index 75ee52e..ce668fb 100644 --- a/Control/Concurrent.hs +++ b/Control/Concurrent.hs @@ -430,7 +430,10 @@ runInUnboundThread action = do if bound then do mv <- newEmptyMVar - _ <- forkIO (Exception.try action >>= putMVar mv) + b <- blocked + _ <- block $ forkIO $ + Exception.try (if b then action else unblock action) >>= + putMVar mv takeMVar mv >>= \ei -> case ei of Left exception -> Exception.throw (exception :: SomeException) Right result -> return result -- 1.7.10.4