[project @ 2000-03-21 15:54:25 by simonmar]

Fix up the tests in here.  Now that threadDelay is interruptible, many
of the tests for block/unblockAsyncExceptions failed because they were
relying on exceptions being blocked during a threadDelay.

diff --git a/ghc/tests/concurrent/should_run/Makefile b/ghc/tests/concurrent/should_run/Makefile
index e53d38f..fb804f0 100644 (file)
--- a/ghc/tests/concurrent/should_run/Makefile
+++ b/ghc/tests/concurrent/should_run/Makefile
@@ -1,12 +1,11 @@
 #-----------------------------------------------------------------------------
-# $Id: Makefile,v 1.3 2000/03/13 11:39:22 simonmar Exp $
+# $Id: Makefile,v 1.4 2000/03/21 15:54:25 simonmar Exp $
 
 TOP = ../..
 include $(TOP)/mk/boilerplate.mk
 include $(TOP)/mk/should_run.mk
 
 conc009_RUNTEST_OPTS = -x 1
-conc018_RUNTEST_OPTS = -x 1
 
 SRC_HC_OPTS += -dcore-lint -syslib concurrent -fglasgow-exts
 

diff --git a/ghc/tests/concurrent/should_run/conc014.hs b/ghc/tests/concurrent/should_run/conc014.hs
index feb9770..650a0d7 100644 (file)
--- a/ghc/tests/concurrent/should_run/conc014.hs
+++ b/ghc/tests/concurrent/should_run/conc014.hs
@@ -10,8 +10,7 @@ main = do
   forkIO (do { takeMVar m;  raiseInThread main_thread (ErrorCall "foo") })
   (error "wibble")
        `catchAllIO` (\e -> do putMVar m ()
-                              threadDelay 500000
-                              putStrLn "done.")
+                              sum [1..10000] `seq` putStrLn "done.")
   (threadDelay 500000)
        `catchAllIO` (\e -> putStrLn ("caught: " ++ show e))
 

diff --git a/ghc/tests/concurrent/should_run/conc015.hs b/ghc/tests/concurrent/should_run/conc015.hs
index ad4fc69..96ce373 100644 (file)
--- a/ghc/tests/concurrent/should_run/conc015.hs
+++ b/ghc/tests/concurrent/should_run/conc015.hs
@@ -22,8 +22,8 @@ main = do
   ( do
     blockAsyncExceptions (do
        putMVar m ()
-       threadDelay 500000
-       (unblockAsyncExceptions (threadDelay 500000))
+       sum [1..10000] `seq` -- give 'foo' a chance to be raised
+         (unblockAsyncExceptions (threadDelay 500000))
                `catchAllIO` (\e -> putStrLn ("caught1: " ++ show e))
      )
     takeMVar m2

diff --git a/ghc/tests/concurrent/should_run/conc016.hs b/ghc/tests/concurrent/should_run/conc016.hs
index 803dfdf..e616a42 100644 (file)
--- a/ghc/tests/concurrent/should_run/conc016.hs
+++ b/ghc/tests/concurrent/should_run/conc016.hs
@@ -12,7 +12,7 @@ main = do
                        )
   blockAsyncExceptions (do
     putMVar m ()
-    threadDelay 500000 -- to be sure the other thread is now blocked
-    killThread sub_thread
+    sum [1..10000] `seq` -- to be sure the other thread is now blocked
+       killThread sub_thread
    )
   putStrLn "ok"

diff --git a/ghc/tests/concurrent/should_run/conc017.hs b/ghc/tests/concurrent/should_run/conc017.hs
index 283e6de..7bdaad2 100644 (file)
--- a/ghc/tests/concurrent/should_run/conc017.hs
+++ b/ghc/tests/concurrent/should_run/conc017.hs
@@ -26,7 +26,7 @@ main = do
         ) `catchAllIO` (\e -> putStrLn ("caught1: " ++ show e))
        putMVar m2 ()
        -- blocked here, "bar" can't be delivered
-       (threadDelay 100000)
+       (sum [1..10000] `seq` return ())
          `catchAllIO` (\e -> putStrLn ("caught2: " ++ show e))
      )
     -- unblocked here, "bar" delivered to "caught3"

diff --git a/ghc/tests/concurrent/should_run/conc018.hs b/ghc/tests/concurrent/should_run/conc018.hs
index 753d45b..56f0e9e 100644 (file)
--- a/ghc/tests/concurrent/should_run/conc018.hs
+++ b/ghc/tests/concurrent/should_run/conc018.hs
@@ -1,7 +1,8 @@
 import Concurrent
+import Exception
 
 main = do
-  catch (do
+  catchAllIO (do
        m <- newMVar ()
        putMVar m ()
      )

diff --git a/ghc/tests/concurrent/should_run/conc018.stderr b/ghc/tests/concurrent/should_run/conc018.stderr
deleted file mode 100644 (file)
index e69de29..0000000

diff --git a/ghc/tests/concurrent/should_run/conc018.stdout b/ghc/tests/concurrent/should_run/conc018.stdout
new file mode 100644 (file)
index 0000000..735e880
--- /dev/null
+++ b/ghc/tests/concurrent/should_run/conc018.stdout
@@ -0,0 +1 @@
+putMVar: full MVar