[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.

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

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

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;
     }