From: Simon Marlow <marlowsd@gmail.com>
Date: Wed, 9 Jul 2008 13:55:58 +0000 (+0000)
Subject: forkOS: start the new thread in blocked mode iff the parent was (#1048)
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=9eda37c15cdfc33cadfa95001c807273679a2fc2;p=ghc-base.git

forkOS: start the new thread in blocked mode iff the parent was (#1048)
This matches the behaviour of forkIO
---

diff --git a/Control/Concurrent.hs b/Control/Concurrent.hs
index aa40b81..78b31fb 100644
--- a/Control/Concurrent.hs
+++ b/Control/Concurrent.hs
@@ -342,10 +342,19 @@ foreign import ccall forkOS_createThread
 failNonThreaded = fail $ "RTS doesn't support multiple OS threads "
                        ++"(use ghc -threaded when linking)"
 
-forkOS action
+forkOS action0
     | rtsSupportsBoundThreads = do
         mv <- newEmptyMVar
-        let action_plus = Exception.catch action childHandler
+        b <- Exception.blocked
+        let
+            -- async exceptions are blocked in the child if they are blocked
+            -- in the parent, as for forkIO (see #1048). forkOS_createThread
+            -- creates a thread with exceptions blocked by default.
+            action1 | b = action0
+                    | otherwise = unblock action0
+
+            action_plus = Exception.catch action1 childHandler
+
         entry <- newStablePtr (myThreadId >>= putMVar mv >> action_plus)
         err <- forkOS_createThread entry
         when (err /= 0) $ fail "Cannot create OS thread."