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.

1 files changed, 16 insertions, 3 deletions

diff --git a/compiler/main/SysTools/Process.hs b/compiler/main/SysTools/Process.hs
index 7ad2cf2f53..c7255b6a93 100644
--- a/compiler/main/SysTools/Process.hs
+++ b/compiler/main/SysTools/Process.hs
@@ -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