[project @ 1999-12-01 16:14:56 by simonmar]

Add some tests for the new async exception behaviour.

diff --git a/ghc/tests/concurrent/should_run/conc014.hs b/ghc/tests/concurrent/should_run/conc014.hs
new file mode 100644 (file)
index 0000000..feb9770
--- /dev/null
+++ b/ghc/tests/concurrent/should_run/conc014.hs
@@ -0,0 +1,17 @@
+import Concurrent
+import Exception
+
+-- Test blocking of async exceptions in an exception handler.
+-- The exception raised in the main thread should not be delivered
+-- until the first exception handler finishes.
+main = do
+  main_thread <- myThreadId
+  m <- newEmptyMVar
+  forkIO (do { takeMVar m;  raiseInThread main_thread (ErrorCall "foo") })
+  (error "wibble")
+       `catchAllIO` (\e -> do putMVar m ()
+                              threadDelay 500000
+                              putStrLn "done.")
+  (threadDelay 500000)
+       `catchAllIO` (\e -> putStrLn ("caught: " ++ show e))
+

diff --git a/ghc/tests/concurrent/should_run/conc014.stdout b/ghc/tests/concurrent/should_run/conc014.stdout
new file mode 100644 (file)
index 0000000..807edef
--- /dev/null
+++ b/ghc/tests/concurrent/should_run/conc014.stdout
@@ -0,0 +1,2 @@
+done.
+caught: foo

diff --git a/ghc/tests/concurrent/should_run/conc015.hs b/ghc/tests/concurrent/should_run/conc015.hs
new file mode 100644 (file)
index 0000000..ad4fc69
--- /dev/null
+++ b/ghc/tests/concurrent/should_run/conc015.hs
@@ -0,0 +1,32 @@
+import Concurrent
+import Exception
+
+-- test blocking & unblocking of async exceptions.
+
+-- the first exception "foo" should be caught by the "caught1" handler,
+-- since async exceptions are blocked outside this handler.
+
+-- the second exception "bar" should be caught by the outer "caught2" handler,
+-- (i.e. this tests that async exceptions are properly unblocked after
+-- being blocked).
+
+main = do
+  main_thread <- myThreadId
+  m <- newEmptyMVar
+  m2 <- newEmptyMVar
+  forkIO (do takeMVar m
+            raiseInThread main_thread (ErrorCall "foo")
+            raiseInThread main_thread (ErrorCall "bar") 
+            putMVar m2 ()
+        )
+  ( do
+    blockAsyncExceptions (do
+       putMVar m ()
+       threadDelay 500000
+       (unblockAsyncExceptions (threadDelay 500000))
+               `catchAllIO` (\e -> putStrLn ("caught1: " ++ show e))
+     )
+    takeMVar m2
+   )
+    `catchAllIO`
+    (\e -> putStrLn ("caught2: " ++ show e))

diff --git a/ghc/tests/concurrent/should_run/conc015.stdout b/ghc/tests/concurrent/should_run/conc015.stdout
new file mode 100644 (file)
index 0000000..f04a8f7
--- /dev/null
+++ b/ghc/tests/concurrent/should_run/conc015.stdout
@@ -0,0 +1,2 @@
+caught1: foo
+caught2: bar

diff --git a/ghc/tests/concurrent/should_run/conc016.hs b/ghc/tests/concurrent/should_run/conc016.hs
new file mode 100644 (file)
index 0000000..803dfdf
--- /dev/null
+++ b/ghc/tests/concurrent/should_run/conc016.hs
@@ -0,0 +1,18 @@
+import Concurrent
+import Exception
+
+-- check that we can still kill a thread that is blocked on
+-- delivering an exception to us.
+main = do
+  main_thread <- myThreadId
+  m <- newEmptyMVar
+  sub_thread <- forkIO (do
+                        takeMVar m
+                        raiseInThread main_thread (ErrorCall "foo")
+                       )
+  blockAsyncExceptions (do
+    putMVar m ()
+    threadDelay 500000 -- to be sure the other thread is now blocked
+    killThread sub_thread
+   )
+  putStrLn "ok"

diff --git a/ghc/tests/concurrent/should_run/conc016.stdout b/ghc/tests/concurrent/should_run/conc016.stdout
new file mode 100644 (file)
index 0000000..9766475
--- /dev/null
+++ b/ghc/tests/concurrent/should_run/conc016.stdout
@@ -0,0 +1 @@
+ok

diff --git a/ghc/tests/concurrent/should_run/conc017.hs b/ghc/tests/concurrent/should_run/conc017.hs
new file mode 100644 (file)
index 0000000..283e6de
--- /dev/null
+++ b/ghc/tests/concurrent/should_run/conc017.hs
@@ -0,0 +1,35 @@
+import Concurrent
+import Exception
+
+-- check that async exceptions are restored to their previous
+-- state after an exception is raised and handled.
+
+main = do
+  main_thread <- myThreadId
+  m1 <- newEmptyMVar
+  m2 <- newEmptyMVar
+  m3 <- newEmptyMVar
+  forkIO (do 
+            takeMVar m1
+            raiseInThread main_thread (ErrorCall "foo")
+            takeMVar m2
+            raiseInThread main_thread (ErrorCall "bar")
+            putMVar m3 ()
+        )
+  (do 
+    blockAsyncExceptions (do
+       (do putMVar m1 () 
+           unblockAsyncExceptions (
+               -- unblocked, "foo" delivered to "caught1"
+              threadDelay 100000
+            )
+        ) `catchAllIO` (\e -> putStrLn ("caught1: " ++ show e))
+       putMVar m2 ()
+       -- blocked here, "bar" can't be delivered
+       (threadDelay 100000)
+         `catchAllIO` (\e -> putStrLn ("caught2: " ++ show e))
+     )
+    -- unblocked here, "bar" delivered to "caught3"
+    takeMVar m3
+   ) 
+   `catchAllIO` (\e -> putStrLn ("caught3: " ++ show e))

diff --git a/ghc/tests/concurrent/should_run/conc017.stdout b/ghc/tests/concurrent/should_run/conc017.stdout
new file mode 100644 (file)
index 0000000..7fca279
--- /dev/null
+++ b/ghc/tests/concurrent/should_run/conc017.stdout
@@ -0,0 +1,2 @@
+caught1: foo
+caught3: bar