From: simonmar <unknown>
Date: Wed, 6 Jul 2005 12:13:04 +0000 (+0000)
Subject: [project @ 2005-07-06 12:13:04 by simonmar]
X-Git-Tag: cmm-merge2~66
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=2c0196592d642891f6504be73ddbc27341622b1a;p=haskell-directory.git

[project @ 2005-07-06 12:13:04 by simonmar]
Close Handles passed to runProcess.  Fixes #1187302
---

diff --git a/System/Process.hs b/System/Process.hs
index 51fd2c3..f30967a 100644
--- a/System/Process.hs
+++ b/System/Process.hs
@@ -51,7 +51,7 @@ import System.Process.Internals
 
 import Foreign
 import Foreign.C 
-import System.IO 	( IOMode(..), Handle )
+import System.IO 	( IOMode(..), Handle, hClose )
 import System.Exit	( ExitCode(..) )
 
 import System.Posix.Internals
@@ -84,7 +84,7 @@ runCommand string = do
      process.  
 
      Any 'Handle's passed to 'runProcess' are placed immediately in the 
-     closed state, so may no longer be referenced by the Haskell process.
+     closed state.
 -}
 runProcess
   :: FilePath			-- ^ Filename of the executable
@@ -96,19 +96,19 @@ runProcess
   -> Maybe Handle		-- ^ Handle to use for @stderr@
   -> IO ProcessHandle
 
+runProcess cmd args mb_cwd mb_env mb_stdin mb_stdout mb_stderr = do
 #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
-
-runProcess cmd args mb_cwd mb_env mb_stdin mb_stdout mb_stderr
- = runProcessPosix "runProcess" cmd args mb_cwd mb_env 
+  h <- runProcessPosix "runProcess" cmd args mb_cwd mb_env 
 	mb_stdin mb_stdout mb_stderr
 	Nothing Nothing
-
 #else
-
-runProcess cmd args mb_cwd mb_env mb_stdin mb_stdout mb_stderr =
-  runProcessWin32 "runProcess" cmd args mb_cwd mb_env 
+  h <- runProcessWin32 "runProcess" cmd args mb_cwd mb_env 
 	mb_stdin mb_stdout mb_stderr ""
 #endif
+  maybe (return ()) hClose mb_stdin
+  maybe (return ()) hClose mb_stdout
+  maybe (return ()) hClose mb_stderr
+  return h
 
 -- ----------------------------------------------------------------------------
 -- runInteractiveCommand