From ce5cf2422d83afa573222490926ecb2104b2ae55 Mon Sep 17 00:00:00 2001
From: simonmar <unknown>
Date: Tue, 21 Mar 2000 15:54:25 +0000
Subject: [PATCH] [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.
---
ghc/tests/concurrent/should_run/Makefile | 3 +--
ghc/tests/concurrent/should_run/conc014.hs | 3 +--
ghc/tests/concurrent/should_run/conc015.hs | 4 ++--
ghc/tests/concurrent/should_run/conc016.hs | 4 ++--
ghc/tests/concurrent/should_run/conc017.hs | 2 +-
ghc/tests/concurrent/should_run/conc018.hs | 3 ++-
ghc/tests/concurrent/should_run/conc018.stderr | 0
ghc/tests/concurrent/should_run/conc018.stdout | 1 +
8 files changed, 10 insertions(+), 10 deletions(-)
delete mode 100644 ghc/tests/concurrent/should_run/conc018.stderr
create mode 100644 ghc/tests/concurrent/should_run/conc018.stdout
diff --git a/ghc/tests/concurrent/should_run/Makefile b/ghc/tests/concurrent/should_run/Makefile
index e53d38ff6383..fb804f0b4e84 100644
--- 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 feb97704cad4..650a0d79d433 100644
--- 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 ad4fc692f7d3..96ce37308957 100644
--- 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 803dfdfaf8d4..e616a42e1ece 100644
--- 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 283e6de7ad75..7bdaad29e8b2 100644
--- 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 753d45b7af30..56f0e9ed21bf 100644
--- 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
index e69de29bb2d1..000000000000
diff --git a/ghc/tests/concurrent/should_run/conc018.stdout b/ghc/tests/concurrent/should_run/conc018.stdout
new file mode 100644
index 000000000000..735e880673ea
--- /dev/null
+++ b/ghc/tests/concurrent/should_run/conc018.stdout
@@ -0,0 +1 @@
+putMVar: full MVar
--
GitLab