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

[ghc-base.git] / System / Event / Thread.hs

diff --git a/System/Event/Thread.hs b/System/Event/Thread.hs
index 72343d9..9c58a5a 100644 (file)
--- a/System/Event/Thread.hs
+++ b/System/Event/Thread.hs
@@ -21,7 +21,6 @@ import GHC.Conc.Sync (TVar, ThreadId, ThreadStatus(..), atomically, forkIO,
 import GHC.IO (mask_, onException)
 import GHC.IO.Exception (ioError)
 import GHC.MVar (MVar, newEmptyMVar, newMVar, putMVar, takeMVar)
-import GHC.Real (fromIntegral)
 import System.Event.Internal (eventIs, evtClose)
 import System.Event.Manager (Event, EventManager, evtRead, evtWrite, loop,
                              new, registerFd, unregisterFd_, registerTimeout)
@@ -128,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