mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

support building with process-1.6.3 again

Browse source
This commit is contained in:
Joey Hess 2020-06-05 11:40:18 -04:00
parent 42756b972e
commit b7619414bf
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
1 changed files with 21 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

23
Utility/Process.hs
View file

@ -23,6 +23,7 @@ module Utility.Process (
withNullHandle,
createProcess,
waitForProcess,
cleanupProcess,
startInteractiveProcess,
stdinHandle,
stdoutHandle,
@ -32,8 +33,8 @@ module Utility.Process (
) where
import qualified Utility.Process.Shim
import qualified Utility.Process.Shim as X hiding (CreateProcess(..), createProcess, runInteractiveProcess, readProcess, readProcessWithExitCode, system, rawSystem, runInteractiveCommand, runProcess)
import Utility.Process.Shim hiding (createProcess, readProcess, waitForProcess)
import qualified Utility.Process.Shim as X hiding (CreateProcess(..), createProcess, runInteractiveProcess, readProcess, readProcessWithExitCode, system, rawSystem, runInteractiveCommand, runProcess, cleanupProcess)
import Utility.Process.Shim hiding (createProcess, readProcess, waitForProcess, cleanupProcess)
import Utility.Misc
import Utility.Exception
import Utility.Monad
@ -197,3 +198,21 @@ waitForProcess h = do
r <- Utility.Process.Shim.waitForProcess h
debugM "Utility.Process" ("process done " ++ show r)
return r
cleanupProcess :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO ()
#if MIN_VERSION_process(1,6,4)
cleanupProcess = Utility.Process.Shim.cleanupProcess
#else
#warning building with process-1.6.3; some timeout features may not work well
cleanupProcess (mb_stdin, mb_stdout, mb_stderr, pid) = do
-- Unlike the real cleanupProcess, this does not wait
-- for the process to finish in the background, so if
-- the process ignores SIGTERM, this can block until the process
-- gets around the exiting.
terminateProcess pid
let void _ = return ()
maybe (return ()) (void . tryNonAsync . hClose) mb_stdin
maybe (return ()) hClose mb_stdout
maybe (return ()) hClose mb_stderr
void $ waitForProcess pid
#endif