From 9ccc022e5b02343ac48ce1d4245c9082f6ab86ef Mon Sep 17 00:00:00 2001 From: Neil Mitchell Date: Mon, 19 Dec 2016 21:33:57 +0000 Subject: [PATCH] Permit process-1.4.3.0 --- CHANGES.txt | 1 + src/General/Process.hs | 7 ++++--- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/CHANGES.txt b/CHANGES.txt index abd3b9b5f..13186dff5 100644 --- a/CHANGES.txt +++ b/CHANGES.txt @@ -1,5 +1,6 @@ Changelog for Shake + Permit process-1.4.3.0 and above #495, remove dangling link from LICENSE #488, make sure parallel tracks dependencies #436, remove Assume, switch to Rebuild diff --git a/src/General/Process.hs b/src/General/Process.hs index 8b992f5ee..5ce81d936 100755 --- a/src/General/Process.hs +++ b/src/General/Process.hs @@ -130,8 +130,9 @@ abort pid = do -- seems to happen with some GHC 7.2 compiled binaries with FFI etc terminateProcess pid -withCreateProcess :: CreateProcess -> ((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO a) -> IO a -withCreateProcess cp act = mask $ \restore -> do +-- FIXME: There is a new withCreateProcess in process-1.4.3.0 which is probably better than ours... +withCreateProcessOld :: CreateProcess -> ((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO a) -> IO a +withCreateProcessOld cp act = mask $ \restore -> do ans@(inh, outh, errh, pid) <- createProcess cp onException (restore $ act ans) $ do mapM_ (`whenJust` hClose) [inh, outh, errh] @@ -157,7 +158,7 @@ process po = do let cp = (cmdSpec poCommand){cwd = poCwd, env = poEnv, create_group = isJust poTimeout, close_fds = True ,std_in = fst $ stdIn inHandle poStdin ,std_out = stdStream outHandle poStdout poStderr, std_err = stdStream outHandle poStderr poStdout} - withCreateProcess cp $ \(inh, outh, errh, pid) -> + withCreateProcessOld cp $ \(inh, outh, errh, pid) -> withTimeout poTimeout (abort pid) $ do let streams = [(outh, stdout, poStdout) | Just outh <- [outh], CreatePipe <- [std_out cp]] ++