[project @ 2005-11-11 12:01:58 by simonmar]

On Windows, attach a finalizer to the ProcessHandle so that we can
call CloseHandle() when the handle is no longer in use.  Previously we
were calling CloseHandle() in waitForProcess and terminateProcess,
which prevented making multiple calls to these functions on the same
handle.

diff --git a/System/Process.hs b/System/Process.hs
index fa10b4c..d4bc43f 100644 (file)
--- a/System/Process.hs
+++ b/System/Process.hs
@@ -167,7 +167,8 @@ runInteractiveProcess1 fun cmd args mb_cwd mb_env = do
      hndStdInput  <- fdToHandle pfdStdInput  WriteMode
      hndStdOutput <- fdToHandle pfdStdOutput ReadMode
      hndStdError  <- fdToHandle pfdStdError  ReadMode
-     return (hndStdInput, hndStdOutput, hndStdError, ProcessHandle proc_handle)
+     ph <- mkProcessHandle proc_handle
+     return (hndStdInput, hndStdOutput, hndStdError, ph)
 
 foreign import ccall unsafe "runInteractiveProcess" 
   c_runInteractiveProcess
@@ -201,8 +202,8 @@ runInteractiveProcess1 fun cmd args workDir env extra_cmdline
        hndStdInput  <- fdToHandle pfdStdInput  WriteMode
        hndStdOutput <- fdToHandle pfdStdOutput ReadMode
        hndStdError  <- fdToHandle pfdStdError  ReadMode
-       return (hndStdInput, hndStdOutput, hndStdError, 
-               ProcessHandle proc_handle)
+       ph <- mkProcessHandle proc_handle
+       return (hndStdInput, hndStdOutput, hndStdError, ph)
 
 foreign import ccall unsafe "runInteractiveProcess" 
   c_runInteractiveProcess
@@ -235,7 +236,8 @@ fdToHandle pfd mode = do
 waitForProcess
   :: ProcessHandle
   -> IO ExitCode
-waitForProcess (ProcessHandle handle) = do
+waitForProcess ph = do
+  handle <- getProcessHandle ph
   code <- throwErrnoIfMinus1 "waitForProcess" (c_waitForProcess handle)
   if (code == 0) 
     then return ExitSuccess
@@ -253,7 +255,8 @@ waitForProcess (ProcessHandle handle) = do
 -- On Windows systems, the Win32 @TerminateProcess@ function is called, passing
 -- an exit code of 1.
 terminateProcess :: ProcessHandle -> IO ()
-terminateProcess (ProcessHandle pid) =
+terminateProcess ph = do
+  pid <- getProcessHandle ph
   throwErrnoIfMinus1_ "terminateProcess" (c_terminateProcess pid)
 
 -- ----------------------------------------------------------------------------
@@ -267,7 +270,8 @@ Subsequent calls to @getProcessExitStatus@ always return @'Just'
 'ExitSuccess'@, regardless of what the original exit code was.
 -}
 getProcessExitCode :: ProcessHandle -> IO (Maybe ExitCode)
-getProcessExitCode (ProcessHandle handle) =
+getProcessExitCode ph = do
+  handle <- getProcessHandle ph
   alloca $ \pExitCode -> do
     res <- throwErrnoIfMinus1 "getProcessExitCode" (c_getProcessExitCode handle pExitCode)
     code <- peek pExitCode

diff --git a/System/Process/Internals.hs b/System/Process/Internals.hs
index 3348306..36b0f24 100644 (file)
--- a/System/Process/Internals.hs
+++ b/System/Process/Internals.hs
@@ -15,7 +15,7 @@
 
 -- #hide
 module System.Process.Internals (
-       ProcessHandle(..), PHANDLE,
+       ProcessHandle(..), PHANDLE, getProcessHandle, mkProcessHandle,
 #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
         pPrPr_disableITimers, c_execvpe,
 # ifdef __GLASGOW_HASKELL__
@@ -40,6 +40,7 @@ import System.Posix.Types ( CPid )
 import System.IO       ( Handle )
 #else
 import Data.Word ( Word32 )
+import Data.IORef
 #endif
 
 import Data.Maybe      ( fromMaybe )
@@ -81,13 +82,39 @@ import System.Directory.Internals ( parseSearchPath, joinFileName )
      to wait for the process later.
 -}
 #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)
+
 #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)
+
+foreign import stdcall unsafe "CloseHandle"
+  c_CloseHandle
+       :: PHANDLE
+       -> IO ()
 #endif
 
-newtype ProcessHandle = ProcessHandle PHANDLE
-
 -- ----------------------------------------------------------------------------
 
 #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
@@ -145,7 +172,7 @@ runProcessPosix fun cmd args mb_cwd mb_env mb_stdin mb_stdout mb_stderr
                 c_runProcess pargs pWorkDir pEnv 
                        fd_stdin fd_stdout fd_stderr
                        set_int inthand set_quit quithand
-        return (ProcessHandle ph)
+        mkProcessHandle ph
 
 foreign import ccall unsafe "runProcess" 
   c_runProcess
@@ -187,7 +214,7 @@ runProcessWin32 fun cmd args mb_cwd mb_env
          proc_handle <- throwErrnoIfMinus1 fun
                          (c_runProcess pcmdline pWorkDir pEnv 
                                fd_stdin fd_stdout fd_stderr)
-         return (ProcessHandle proc_handle)
+        mkProcessHandle proc_handle
 
 foreign import ccall unsafe "runProcess" 
   c_runProcess

diff --git a/cbits/runProcess.c b/cbits/runProcess.c
index 0a69421..a0c2453 100644 (file)
--- a/cbits/runProcess.c
+++ b/cbits/runProcess.c
@@ -518,8 +518,6 @@ terminateProcess (ProcHandle handle)
        maperrno();
        return -1;
     }
-
-    CloseHandle((HANDLE) handle);
     return 0;
 }
 
@@ -535,8 +533,6 @@ getProcessExitCode (ProcHandle handle, int *pExitCode)
            maperrno();
            return -1;
        }
-       
-       CloseHandle((HANDLE) handle);
        return 1;
     }
     
@@ -555,8 +551,6 @@ waitForProcess (ProcHandle handle)
            maperrno();
            return -1;
        }
-       
-       CloseHandle((HANDLE) handle);
        return retCode;
     }