[project @ 2001-03-08 13:41:31 by simonmar]

update for blocking putMVar

1 files changed, 12 insertions, 6 deletions

diff --git a/ghc/tests/concurrent/should_run/conc018.hs b/ghc/tests/concurrent/should_run/conc018.hs
index 6ffe8877f8..34894e117c 100644
--- a/ghc/tests/concurrent/should_run/conc018.hs
+++ b/ghc/tests/concurrent/should_run/conc018.hs
@@ -1,10 +1,16 @@
 import Concurrent
 import Exception
 
+-- test that putMVar blocks on a full MVar rather than raising an
+-- exception.
+
 main = do
-  Exception.catch (do
-  	m <- newMVar ()
-	putMVar m ()
-     )
-     (\e -> print e)
- 
+  t <- forkIO (
+	    Exception.catch (do
+		m <- newMVar ()
+		putMVar m ()
+	     )
+	     (\e -> print e)
+	   )
+  threadDelay 500000
+  killThread t