From 3518dc689426fe6389d1dfe82094cd6f51603464 Mon Sep 17 00:00:00 2001
From: simonm <unknown>
Date: Mon, 17 Aug 1998 12:23:00 +0000
Subject: [PATCH] [project @ 1998-08-17 12:23:00 by simonm] Fix test to wait
for all threads to run before ending.
---
ghc/tests/concurrent/should_run/conc004.hs | 14 ++++++++++----
ghc/tests/concurrent/should_run/conc004.stdout | 2 +-
2 files changed, 11 insertions(+), 5 deletions(-)
diff --git a/ghc/tests/concurrent/should_run/conc004.hs b/ghc/tests/concurrent/should_run/conc004.hs
index 6a1ee0f6946d..2580636585e1 100644
--- a/ghc/tests/concurrent/should_run/conc004.hs
+++ b/ghc/tests/concurrent/should_run/conc004.hs
@@ -6,8 +6,14 @@ module Main where
import Concurrent
main :: IO ()
-main = spawner forkIO 1000000
+main = do
+ mvar <- newEmptyMVar
-spawner :: (IO () -> IO ()) -> Int -> IO ()
-spawner c 0 = print "done"
-spawner c n = do { c (spawner c (n-1)); return ()}
+ let
+ spawner :: (IO () -> IO ()) -> Int -> IO ()
+ spawner c 0 = putMVar mvar ()
+ spawner c n = do { c (spawner c (n-1)); return ()}
+
+ spawner forkIO 1000000
+ takeMVar mvar
+ putStr "done"
diff --git a/ghc/tests/concurrent/should_run/conc004.stdout b/ghc/tests/concurrent/should_run/conc004.stdout
index be54b4b4e39e..348ebd9491ed 100644
--- a/ghc/tests/concurrent/should_run/conc004.stdout
+++ b/ghc/tests/concurrent/should_run/conc004.stdout
@@ -1 +1 @@
-"done"
+done
\ No newline at end of file
--
GitLab