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 (file)
--- 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