[project @ 2005-11-17 11:28:43 by simonmar]

ProcessHandle is now an MVar, in which we cache the ExitCode of the
process when we know it.

Additionally, waitForProcess and getProcessExitCode now close the
handle eagerly on Windows, this avoids a problem with hsc2hs which
wants to remove the executable it just ran, and it can't if the handle
is still open.

diff --git a/System/Process.hs b/System/Process.hs
index d4bc43f..91a9359 100644 (file)
--- a/System/Process.hs
+++ b/System/Process.hs
@@ -237,11 +237,23 @@ waitForProcess
   :: ProcessHandle
   -> IO ExitCode
 waitForProcess ph = do
-  handle <- getProcessHandle ph
-  code <- throwErrnoIfMinus1 "waitForProcess" (c_waitForProcess handle)
-  if (code == 0) 
-    then return ExitSuccess
-    else return (ExitFailure (fromIntegral code))
+  p_ <- withProcessHandle ph $ \p_ -> return (p_,p_)
+  case p_ of
+    ClosedHandle e -> return e
+    OpenHandle h  -> do
+       -- don't hold the MVar while we call c_waitForProcess...
+       -- (XXX but there's a small race window here during which another
+       -- thread could close the handle or call waitForProcess)
+       code <- throwErrnoIfMinus1 "waitForProcess" (c_waitForProcess h)
+       withProcessHandle ph $ \p_ ->
+         case p_ of
+           ClosedHandle e -> return (p_,e)
+           OpenHandle ph  -> do
+             closePHANDLE ph
+             let e = if (code == 0)
+                  then ExitSuccess
+                  else (ExitFailure (fromIntegral code))
+             return (ClosedHandle e, e)
 
 -- ----------------------------------------------------------------------------
 -- terminateProcess
@@ -256,8 +268,14 @@ waitForProcess ph = do
 -- an exit code of 1.
 terminateProcess :: ProcessHandle -> IO ()
 terminateProcess ph = do
-  pid <- getProcessHandle ph
-  throwErrnoIfMinus1_ "terminateProcess" (c_terminateProcess pid)
+  withProcessHandle_ ph $ \p_ ->
+    case p_ of 
+      ClosedHandle _ -> return p_
+      OpenHandle h -> do
+       throwErrnoIfMinus1_ "terminateProcess" $ c_terminateProcess h
+       return p_
+       -- does not close the handle, we might want to try terminating it
+       -- again, or get its exit code.
 
 -- ----------------------------------------------------------------------------
 -- getProcessExitCode
@@ -271,15 +289,21 @@ Subsequent calls to @getProcessExitStatus@ always return @'Just'
 -}
 getProcessExitCode :: ProcessHandle -> IO (Maybe ExitCode)
 getProcessExitCode ph = do
-  handle <- getProcessHandle ph
-  alloca $ \pExitCode -> do
-    res <- throwErrnoIfMinus1 "getProcessExitCode" (c_getProcessExitCode handle pExitCode)
-    code <- peek pExitCode
-    if res == 0
-      then return Nothing
-      else if code == 0
-             then return (Just ExitSuccess)
-             else return (Just (ExitFailure (fromIntegral code)))
+  withProcessHandle ph $ \p_ ->
+    case p_ of
+      ClosedHandle e -> return (p_, Just e)
+      OpenHandle h ->
+       alloca $ \pExitCode -> do
+           res <- throwErrnoIfMinus1 "getProcessExitCode" $
+                       c_getProcessExitCode h pExitCode
+           code <- peek pExitCode
+           if res == 0
+             then return (p_, Nothing)
+             else do
+                  closePHANDLE h
+                  let e  | code == 0 = ExitSuccess
+                         | otherwise = ExitFailure (fromIntegral code)
+                  return (ClosedHandle e, Just e)
 
 -- ----------------------------------------------------------------------------
 -- Interface to C bits

diff --git a/System/Process/Internals.hs b/System/Process/Internals.hs
index 36b0f24..b0af3de 100644 (file)
--- a/System/Process/Internals.hs
+++ b/System/Process/Internals.hs
@@ -15,7 +15,9 @@
 
 -- #hide
 module System.Process.Internals (
-       ProcessHandle(..), PHANDLE, getProcessHandle, mkProcessHandle,
+       ProcessHandle(..), ProcessHandle__(..), 
+       PHANDLE, closePHANDLE, mkProcessHandle, 
+       withProcessHandle, withProcessHandle_,
 #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
         pPrPr_disableITimers, c_execvpe,
 # ifdef __GLASGOW_HASKELL__
@@ -43,6 +45,7 @@ import Data.Word ( Word32 )
 import Data.IORef
 #endif
 
+import System.Exit     ( ExitCode )
 import Data.Maybe      ( fromMaybe )
 # ifdef __GLASGOW_HASKELL__
 import GHC.IOBase      ( haFD, FD, Exception(..), IOException(..) )
@@ -51,6 +54,7 @@ import GHC.Handle     ( stdin, stdout, stderr, withHandle_ )
 import Hugs.Exception  ( Exception(..), IOException(..) )
 # endif
 
+import Control.Concurrent
 import Control.Exception ( handle, throwIO )
 import Foreign.C
 import Foreign
@@ -81,33 +85,55 @@ import System.Directory.Internals ( parseSearchPath, joinFileName )
      termination: they all return a 'ProcessHandle' which may be used
      to wait for the process later.
 -}
+data ProcessHandle__ = OpenHandle PHANDLE | ClosedHandle ExitCode
+newtype ProcessHandle = ProcessHandle (MVar ProcessHandle__)
+
+withProcessHandle
+       :: ProcessHandle 
+       -> (ProcessHandle__ -> IO (ProcessHandle__, a))
+       -> IO a
+withProcessHandle (ProcessHandle m) io = modifyMVar m io
+
+withProcessHandle_
+       :: ProcessHandle 
+       -> (ProcessHandle__ -> IO ProcessHandle__)
+       -> IO ()
+withProcessHandle_ (ProcessHandle m) io = modifyMVar_ m io
+
 #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
 
 type PHANDLE = CPid
-newtype ProcessHandle = ProcessHandle PHANDLE
-
-getProcessHandle :: ProcessHandle -> IO PHANDLE
-getProcessHandle (ProcessHandle p) = return p
 
 mkProcessHandle :: PHANDLE -> IO ProcessHandle
-mkProcessHandle p = return (ProcessHandle p)
+mkProcessHandle p = do
+  m <- newMVar (OpenHandle p)
+  return (ProcessHandle m)
+
+closePHANDLE :: PHANDLE -> IO ()
+closePHANDLE _ = return ()
 
 #else
 
 type PHANDLE = Word32
-newtype ProcessHandle = ProcessHandle (IORef PHANDLE)
-
-getProcessHandle :: ProcessHandle -> IO PHANDLE
-getProcessHandle (ProcessHandle ior) = readIORef ior
 
 -- On Windows, we have to close this HANDLE when it is no longer required,
 -- hence we add a finalizer to it, using an IORef as the box on which to
 -- attach the finalizer.
 mkProcessHandle :: PHANDLE -> IO ProcessHandle
 mkProcessHandle h = do
-   ioref <- newIORef h
-   mkWeakIORef ioref (c_CloseHandle h)
-   return (ProcessHandle ioref)
+   m <- newMVar (OpenHandle h)
+   addMVarFinalizer m (processHandleFinaliser m)
+   return (ProcessHandle m)
+
+processHandleFinaliser m =
+   modifyMVar_ m $ \p_ -> do 
+       case p_ of
+         OpenHandle ph -> closePHANDLE ph
+         _ -> return ()
+       return (error "closed process handle")
+
+closePHANDLE :: PHANDLE -> IO ()
+closePHANDLE ph = c_CloseHandle ph
 
 foreign import stdcall unsafe "CloseHandle"
   c_CloseHandle