From: Dmitry Astapov <dastapov@gmail.com>
Date: Wed, 19 Jan 2011 10:33:00 +0000 (+0000)
Subject: Clean up remnants of the Event Manager after forkProcess. Closes #4449
X-Git-Url: http://git.megacz.com/?p=ghc-base.git;a=commitdiff_plain;h=b11d520a48696daf7bf1d191352c31ab41eddf9e

Clean up remnants of the Event Manager after forkProcess. Closes #4449
---

diff --git a/System/Event/Manager.hs b/System/Event/Manager.hs
index c47b6c6..0c8293f 100644
--- a/System/Event/Manager.hs
+++ b/System/Event/Manager.hs
@@ -14,6 +14,7 @@ module System.Event.Manager
     , loop
     , step
     , shutdown
+    , cleanup
     , wakeManager
 
       -- * Registering interest in I/O events
diff --git a/System/Event/Thread.hs b/System/Event/Thread.hs
index 59bf7e8..9c58a5a 100644
--- a/System/Event/Thread.hs
+++ b/System/Event/Thread.hs
@@ -127,7 +127,17 @@ ensureIOManagerIsRunning
       s <- threadStatus t
       case s of
         ThreadFinished -> create
-        ThreadDied     -> create
+        ThreadDied     -> do 
+          -- Sanity check: if the thread has died, there is a chance
+          -- that event manager is still alive. This could happend during
+          -- the fork, for example. In this case we should clean up
+          -- open pipes and everything else related to the event manager.
+          -- See #4449
+          mem <- readIORef eventManager
+          _ <- case mem of
+                 Nothing -> return ()
+                 Just em -> M.cleanup em
+          create
         _other         -> return st
 
 foreign import ccall unsafe "rtsSupportsBoundThreads" threaded :: Bool