From 4bfb59c9d1c3fb12bdfe9e9b7750115e3046635c Mon Sep 17 00:00:00 2001
From: Ben Gamari <ben@smart-cactus.org>
Date: Sun, 31 May 2020 17:21:41 -0400
Subject: [PATCH] testsuite: Add process-fork-wait test

---
 tests/all.T                    |  1 +
 tests/process-fork-wait.hs     | 42 ++++++++++++++++++++++++++++++++++
 tests/process-fork-wait.stdout |  4 ++++
 3 files changed, 47 insertions(+)
 create mode 100644 tests/process-fork-wait.hs
 create mode 100644 tests/process-fork-wait.stdout

diff --git a/tests/all.T b/tests/all.T
index 33f4cdd3..a92ca457 100644
--- a/tests/all.T
+++ b/tests/all.T
@@ -38,3 +38,4 @@ test('process010', normal, compile_and_run, [''])
 test('process011', when(opsys('mingw32'), skip), compile_and_run, [''])
 
 test('T8343', normal, compile_and_run, [''])
+test('process-fork-wait', normal, compile_and_run, [''])
diff --git a/tests/process-fork-wait.hs b/tests/process-fork-wait.hs
new file mode 100644
index 00000000..9b916dab
--- /dev/null
+++ b/tests/process-fork-wait.hs
@@ -0,0 +1,42 @@
+-- | This test verifies that the 'use_process_jobs' feature works as
+-- advertised. Specifically: on Windows 'waitForProcess' should not return
+-- until all processes created by the child (including those created with
+-- @fork@) have exited if 'use_process_jobs' is enabled.
+--
+
+module Main where
+
+import Control.Concurrent
+import Control.Monad
+import System.Environment
+import System.IO
+import System.Process
+
+main :: IO ()
+main = do
+    args <- getArgs
+    run args
+
+run :: [String] -> IO ()
+run [] = do
+    putStrLn "starting A"
+    hFlush stdout
+    -- Disabling use_process_jobs here will cause waitForProcess to return
+    -- before the process B invocation has written the test file.
+    (_,_,_,p) <- createProcess $ (proc "process-fork-wait" ["A"]) { use_process_jobs = True }
+    void $ waitForProcess p
+    contents <- readFile "test"
+    when (contents /= "looks good to me")
+        $ fail "invalid file contents"
+run ["A"] = do
+    putStrLn "A started"
+    hFlush stdout
+    (_,_,_,_) <- createProcess $ (proc "process-fork-wait" ["B"])
+    return ()
+run ["B"] = do
+    putStrLn "B started"
+    hFlush stdout
+    threadDelay (5*1000*1000)
+    writeFile "test" "looks good to me"
+    putStrLn "B finished"
+run _ = fail "unknown mode"
diff --git a/tests/process-fork-wait.stdout b/tests/process-fork-wait.stdout
new file mode 100644
index 00000000..437a6306
--- /dev/null
+++ b/tests/process-fork-wait.stdout
@@ -0,0 +1,4 @@
+starting A
+A started
+B started
+B finished