summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBen Gamari <ben@smart-cactus.org>2020-02-24 15:47:16 -0500
committerMarge Bot <ben+marge-bot@smart-cactus.org>2020-02-26 15:10:09 -0500
commit9ee7f87dbea786259d12fb9177fd2759d4fad3bb (patch)
tree5f182788777bdf479a33b94ae329eabd22433774
parent557699967f9438d3bf2936cbc6edce55b11622e0 (diff)
downloadhaskell-9ee7f87dbea786259d12fb9177fd2759d4fad3bb.tar.gz
SysTools: Don't use process jobs if they are broken
-rw-r--r--compiler/main/SysTools/Process.hs30
1 files changed, 22 insertions, 8 deletions
diff --git a/compiler/main/SysTools/Process.hs b/compiler/main/SysTools/Process.hs
index 8772e3eec1..b36b53c5e5 100644
--- a/compiler/main/SysTools/Process.hs
+++ b/compiler/main/SysTools/Process.hs
@@ -32,6 +32,19 @@ import System.Process
import FileCleanup
+-- | Enable process jobs support on Windows if it can be expected to work (e.g.
+-- @process >= 1.6.8.0@).
+enableProcessJobs :: CreateProcess -> CreateProcess
+#if defined(MIN_VERSION_process)
+#if MIN_VERSION_process(1,6,8)
+enableProcessJobs opts = opts { use_process_jobs = True }
+#else
+enableProcessJobs opts = opts
+#endif
+#else
+enableProcessJobs opts = opts
+#endif
+
-- Similar to System.Process.readCreateProcessWithExitCode, but stderr is
-- inherited from the parent process, and output to stderr is not captured.
readCreateProcessWithExitCode'
@@ -68,7 +81,7 @@ readProcessEnvWithExitCode
-> IO (ExitCode, String, String) -- ^ (exit_code, stdout, stderr)
readProcessEnvWithExitCode prog args env_update = do
current_env <- getEnvironment
- readCreateProcessWithExitCode ((proc prog args) {use_process_jobs = True}) {
+ readCreateProcessWithExitCode (enableProcessJobs $ proc prog args) {
env = Just (replaceVar env_update current_env) } ""
-- Don't let gcc localize version info string, #8825
@@ -226,13 +239,14 @@ builderMainLoop dflags filter_fn pgm real_args mb_cwd mb_env = do
-- not have finished yet. This caused #16450. To fix this use a
-- process job to track all child processes and wait for each one to
-- finish.
- let procdata = (proc pgm real_args) { cwd = mb_cwd
- , env = mb_env
- , use_process_jobs = True
- , std_in = CreatePipe
- , std_out = CreatePipe
- , std_err = CreatePipe
- }
+ let procdata =
+ enableProcessJobs
+ $ (proc pgm real_args) { cwd = mb_cwd
+ , env = mb_env
+ , std_in = CreatePipe
+ , std_out = CreatePipe
+ , std_err = CreatePipe
+ }
(Just hStdIn, Just hStdOut, Just hStdErr, hProcess) <- restore $
createProcess_ "builderMainLoop" procdata
let cleanup_handles = do