[commit: base] : closeFdWith invokes callbacks only after the fd is closed. (beff541)

[Johan Tibell]

Repository : ssh://darcs.haskell.org//srv/darcs/packages/base

On branch  : 

http://hackage.haskell.org/trac/ghc/changeset/beff54173fb3f8dd7b9a8bb81512da315005b8aa

>---------------------------------------------------------------

commit beff54173fb3f8dd7b9a8bb81512da315005b8aa
Author: Andreas Voellmy <andreas.voellmy at gmail.com>
Date:   Fri Jan 4 10:12:58 2013 -0500

    closeFdWith invokes callbacks only after the fd is closed.
    
    Move callback invocation to after close. close must be run after the all backends are updated. Therefore the sequence is to update the backends, in the process getting the callbacks to invoke (actually just getting an IO action which when executed will execute the callbacks), call close, and finally update the Managers' callback tables for the fd and execute the callbacks.

>---------------------------------------------------------------

 GHC/Event/Manager.hs |   15 ++++++++++-----
 GHC/Event/Thread.hs  |   17 +++++++++--------
 2 files changed, 19 insertions(+), 13 deletions(-)

diff --git a/GHC/Event/Manager.hs b/GHC/Event/Manager.hs
index 32dfc6d..1f956a1 100644
--- a/GHC/Event/Manager.hs
+++ b/GHC/Event/Manager.hs
@@ -362,18 +362,23 @@ closeFd mgr close fd = do
 
 -- | Close a file descriptor in a race-safe way. 
 -- It assumes the caller will update the callback tables and that the caller
--- holds the callback table lock for the fd.
-closeFd_ :: EventManager -> IM.IntMap [FdData] -> Fd -> IO (IM.IntMap [FdData])
+-- holds the callback table lock for the fd. It must hold this lock because
+-- this command executes a backend command on the fd.
+closeFd_ :: EventManager
+            -> IM.IntMap [FdData]
+            -> Fd
+            -> IO (IM.IntMap [FdData], IO ())
 closeFd_ mgr oldMap fd = do
   case IM.delete (fromIntegral fd) oldMap of
-    (Nothing,  _)       -> return oldMap
+    (Nothing,  _)       -> return (oldMap, return ())
     (Just fds, !newMap) -> do
       let oldEvs = eventsOf fds
       when (oldEvs /= mempty) $ do
         I.modifyFd (emBackend mgr) fd oldEvs mempty
         wakeManager mgr
-      forM_ fds $ \(FdData reg ev cb) -> cb reg (ev `mappend` evtClose)
-      return newMap
+      let runCbs =
+            forM_ fds $ \(FdData reg ev cb) -> cb reg (ev `mappend` evtClose)
+      return (newMap, runCbs)
 ------------------------------------------------------------------------
 -- Utilities
 
diff --git a/GHC/Event/Thread.hs b/GHC/Event/Thread.hs
index 578e591..b0d55a6 100644
--- a/GHC/Event/Thread.hs
+++ b/GHC/Event/Thread.hs
@@ -100,15 +100,16 @@ closeFdWith close fd = do
     return mgr
   mask_ $ do
     tables <- forM mgrs $ \mgr -> takeMVar $ M.callbackTableVar mgr fd
-    tables' <- zipWithM
-               (\mgr table -> M.closeFd_ mgr table fd)
-               mgrs
-               tables
+    tableAndCbApps <- zipWithM
+                      (\mgr table -> M.closeFd_ mgr table fd)
+                      mgrs
+                      tables
     close fd
-    zipWithM_
-      (\mgr table' -> putMVar (M.callbackTableVar mgr fd) table')
-      mgrs
-      tables'
+    zipWithM_ finish mgrs tableAndCbApps
+  where
+    finish mgr (table', cbApp) = do
+      putMVar (M.callbackTableVar mgr fd) table'
+      cbApp
 
 threadWait :: Event -> Fd -> IO ()
 threadWait evt fd = mask_ $ do