From: Bas van Dijk <v.dijk.bas@gmail.com>
Date: Mon, 29 Mar 2010 13:16:24 +0000 (+0000)
Subject: withThread: block asynchronous exceptions before installing exception handler.
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;ds=sidebyside;h=1c9b35dcdfbec4c68c65f770bb13e71617e919f9;p=ghc-base.git

withThread: block asynchronous exceptions before installing exception handler.
Note that I don't unblock the given io computation. Because AFAICS
withThread is only called with 'waitFd' which only performs an FFI
call which can't receive asynchronous exceptions anyway.
---

diff --git a/Control/Concurrent.hs b/Control/Concurrent.hs
index ce668fb..a25e659 100644
--- a/Control/Concurrent.hs
+++ b/Control/Concurrent.hs
@@ -482,7 +482,7 @@ foreign import ccall unsafe "rtsSupportsBoundThreads" threaded :: Bool
 withThread :: IO a -> IO a
 withThread io = do
   m <- newEmptyMVar
-  _ <- forkIO $ try io >>= putMVar m
+  _ <- block $ forkIO $ try io >>= putMVar m
   x <- takeMVar m
   case x of
     Right a -> return a