diff --git a/ghc/tests/concurrent/should_run/conc004.hs b/ghc/tests/concurrent/should_run/conc004.hs
index 6a1ee0f6946d1537e38a1b7dc878baeca2ab35c1..2580636585e1b4fb70d2e4024a1308c376c719d1 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 be54b4b4e39e5f48f3d3746f5908e13d35410d09..348ebd9491ed019f54af8f313ce8a4d782e0e609 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