Commit 463b9b86 authored by Tamar Christina's avatar Tamar Christina Committed by Ben Gamari
Browse files

SysTools: Use "process job" when spawning processes on Windows

GHC should make calls using process jobs when calling out to GCC and LD.
The reason is these use the exec () family of posix functions.  Window's
process model doesn't allow replacement of processes so this is emulated
by creating a new process and immediately exiting the old one.  Because
of this when using normal Windows wait functions you would return even
without the child process having finished.  In this case if you are
depending on data from the child you will enter a race condition.

The usual fix for this is to use process jobs and wait for the
termination of all children that have ever been spawn by the process you
called. But also waiting for the freeing of all resources.
parent 8cbf1a5b
......@@ -68,7 +68,7 @@ readProcessEnvWithExitCode
-> IO (ExitCode, String, String) -- ^ (exit_code, stdout, stderr)
readProcessEnvWithExitCode prog args env_update = do
current_env <- getEnvironment
readCreateProcessWithExitCode (proc prog args) {
readCreateProcessWithExitCode ((proc prog args) {use_process_jobs = True}) {
env = Just (replaceVar env_update current_env) } ""
-- Don't let gcc localize version info string, #8825
......@@ -220,8 +220,21 @@ builderMainLoop dflags filter_fn pgm real_args mb_cwd mb_env = do
-- unless an exception was raised.
let safely inner = mask $ \restore -> do
-- acquire
(hStdIn, hStdOut, hStdErr, hProcess) <- restore $
runInteractiveProcess pgm real_args mb_cwd mb_env
-- On Windows due to how exec is emulated the old process will exit and
-- a new process will be created. This means waiting for termination of
-- the parent process will get you in a race condition as the child may
-- 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
(Just hStdIn, Just hStdOut, Just hStdErr, hProcess) <- restore $
createProcess_ "builderMainLoop" procdata
let cleanup_handles = do
hClose hStdIn
hClose hStdOut
Supports Markdown
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