From 3518dc689426fe6389d1dfe82094cd6f51603464 Mon Sep 17 00:00:00 2001 From: simonm 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 6a1ee0f..2580636 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 be54b4b..348ebd9 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 -- 1.7.10.4