[commit: packages/process] master, wip/issue15: If create process fails, reset ctl-C delegation (2293a4c)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/process

On branches: master,wip/issue15
Link       : http://ghc.haskell.org/trac/ghc/changeset/2293a4ca4cceba8e7ec42627f7e86eee6e6383cf/process

>---------------------------------------------------------------

commit 2293a4ca4cceba8e7ec42627f7e86eee6e6383cf
Author: Duncan Coutts <duncan at community.haskell.org>
Date:   Sat Jan 10 20:45:37 2015 +0000

    If create process fails, reset ctl-C delegation
    
    createProcess has a feature for delegated control-C handling. If
    createProcess fails to start the new process then we must undo
    the delegated control-C handling. This fixes issue #15.


>---------------------------------------------------------------

2293a4ca4cceba8e7ec42627f7e86eee6e6383cf
 System/Process/Internals.hs | 10 ++++++++--
 1 file changed, 8 insertions(+), 2 deletions(-)

diff --git a/System/Process/Internals.hs b/System/Process/Internals.hs
index 90651d0..e46ddb6 100644
--- a/System/Process/Internals.hs
+++ b/System/Process/Internals.hs
@@ -293,6 +293,8 @@ createProcess_ fun CreateProcess{ cmdspec = cmdsp,
      when (proc_handle == -1) $ do
          cFailedDoing <- peek pFailedDoing
          failedDoing <- peekCString cFailedDoing
+         when mb_delegate_ctlc
+           stopDelegateControlC
          throwErrno (fun ++ ": " ++ failedDoing)
 
      hndStdInput  <- mbPipe mb_stdin  pfdStdInput  WriteMode
@@ -349,8 +351,8 @@ startDelegateControlC =
           let !count' = count + 1
           return (Just (count', old_int, old_quit))
 
-endDelegateControlC :: ExitCode -> IO ()
-endDelegateControlC exitCode = do
+stopDelegateControlC :: IO ()
+stopDelegateControlC =
     modifyMVar_ runInteractiveProcess_delegate_ctlc $ \delegating -> do
       case delegating of
         Just (1, old_int, old_quit) -> do
@@ -368,6 +370,10 @@ endDelegateControlC exitCode = do
 
         Nothing -> return Nothing -- should be impossible
 
+endDelegateControlC :: ExitCode -> IO ()
+endDelegateControlC exitCode = do
+    stopDelegateControlC
+
     -- And if the process did die due to SIGINT or SIGQUIT then
     -- we throw our equivalent exception here (synchronously).
     --