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.
:: ProcessHandle
-> IO ExitCode
waitForProcess ph = do
:: 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
-- ----------------------------------------------------------------------------
-- terminateProcess
-- an exit code of 1.
terminateProcess :: ProcessHandle -> IO ()
terminateProcess 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
-- ----------------------------------------------------------------------------
-- getProcessExitCode
-}
getProcessExitCode :: ProcessHandle -> IO (Maybe ExitCode)
getProcessExitCode ph = do
-}
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
-- ----------------------------------------------------------------------------
-- Interface to C bits
-- #hide
module System.Process.Internals (
-- #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__
#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
pPrPr_disableITimers, c_execvpe,
# ifdef __GLASGOW_HASKELL__
+import System.Exit ( ExitCode )
import Data.Maybe ( fromMaybe )
# ifdef __GLASGOW_HASKELL__
import GHC.IOBase ( haFD, FD, Exception(..), IOException(..) )
import Data.Maybe ( fromMaybe )
# ifdef __GLASGOW_HASKELL__
import GHC.IOBase ( haFD, FD, Exception(..), IOException(..) )
import Hugs.Exception ( Exception(..), IOException(..) )
# endif
import Hugs.Exception ( Exception(..), IOException(..) )
# endif
+import Control.Concurrent
import Control.Exception ( handle, throwIO )
import Foreign.C
import Foreign
import Control.Exception ( handle, throwIO )
import Foreign.C
import Foreign
termination: they all return a 'ProcessHandle' which may be used
to wait for the process later.
-}
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
#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 :: 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
#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
-- 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
foreign import stdcall unsafe "CloseHandle"
c_CloseHandle