Commit 8895de09 authored by Ben Gamari's avatar Ben Gamari 🐢

Check exit code of processes using jobs in two stages

Previously we would rely on the exit

This fixes a few nasty bugs:

 * System.Process.waitForProcess failed to keep the ProcessHandle's MVar
   alive, potentially resulting in the finalizer being run while
   waitForJobCompletion is executing. This would cause the process
   handles to be closed, resulting in waitForJobCompletion to fail.

 * waitForProcess failed to explicitly close the job, process, and IOCP
   handles.

 * waitForProcess failed to stop delegation of Ctrl-C in processes using
   jobs.
parent d6ff8928
...@@ -642,28 +642,35 @@ waitForProcess ph@(ProcessHandle _ delegating_ctlc _) = lockWaitpid $ do ...@@ -642,28 +642,35 @@ waitForProcess ph@(ProcessHandle _ delegating_ctlc _) = lockWaitpid $ do
case p_ of case p_ of
ClosedHandle e -> return e ClosedHandle e -> return e
OpenHandle h -> do OpenHandle h -> do
e <- alloca $ \pret -> do -- don't hold the MVar while we call c_waitForProcess...
-- don't hold the MVar while we call c_waitForProcess... e <- waitForProcess' h
throwErrnoIfMinus1Retry_ "waitForProcess" (allowInterrupt >> c_waitForProcess h pret) e' <- modifyProcessHandle ph $ \p_' ->
modifyProcessHandle ph $ \p_' -> case p_' of
case p_' of ClosedHandle e' -> return (p_', e')
ClosedHandle e -> return (p_', e) OpenExtHandle{} -> fail "waitForProcess(OpenExtHandle): this cannot happen"
OpenExtHandle{} -> return (p_', ExitFailure (-1)) OpenHandle ph' -> do
OpenHandle ph' -> do closePHANDLE ph'
closePHANDLE ph' when delegating_ctlc $
code <- peek pret endDelegateControlC e
let e = if (code == 0) return (ClosedHandle e, e)
then ExitSuccess return e'
else (ExitFailure (fromIntegral code))
return (ClosedHandle e, e)
when delegating_ctlc $
endDelegateControlC e
return e
#if defined(WINDOWS) #if defined(WINDOWS)
OpenExtHandle _ job iocp -> OpenExtHandle h job iocp -> do
maybe (ExitFailure (-1)) mkExitCode `fmap` waitForJobCompletion job iocp timeout_Infinite -- First wait for completion of the job...
where mkExitCode code | code == 0 = ExitSuccess code <- waitForJobCompletion job iocp timeout_Infinite
| otherwise = ExitFailure $ fromIntegral code let e = maybe (ExitFailure (-1)) mkExitCode code
e' <- modifyProcessHandle ph $ \p_' ->
case p_' of
ClosedHandle e' -> return (p_', e')
OpenHandle{} -> fail "waitForProcess(OpenHandle): this cannot happen"
OpenExtHandle ph' job' iocp' -> do
closePHANDLE ph'
closePHANDLE job'
closePHANDLE iocp'
when delegating_ctlc $
endDelegateControlC e
return (ClosedHandle e, e)
return e
#else #else
OpenExtHandle _ _job _iocp -> OpenExtHandle _ _job _iocp ->
return $ ExitFailure (-1) return $ ExitFailure (-1)
...@@ -676,6 +683,17 @@ waitForProcess ph@(ProcessHandle _ delegating_ctlc _) = lockWaitpid $ do ...@@ -676,6 +683,17 @@ waitForProcess ph@(ProcessHandle _ delegating_ctlc _) = lockWaitpid $ do
-- https://github.com/haskell/process/pull/58 for further discussion -- https://github.com/haskell/process/pull/58 for further discussion
lockWaitpid m = withMVar (waitpidLock ph) $ \() -> m lockWaitpid m = withMVar (waitpidLock ph) $ \() -> m
waitForProcess' :: PHANDLE -> IO ExitCode
waitForProcess' h = alloca $ \pret -> do
throwErrnoIfMinus1Retry_ "waitForProcess" (allowInterrupt >> c_waitForProcess h pret)
mkExitCode <$> peek pret
mkExitCode :: CInt -> ExitCode
mkExitCode code
| code == 0 = ExitSuccess
| otherwise = ExitFailure (fromIntegral code)
-- ---------------------------------------------------------------------------- -- ----------------------------------------------------------------------------
-- getProcessExitCode -- getProcessExitCode
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment