From 8eceeddbc565fa41ba880710deddaac2728fec33 Mon Sep 17 00:00:00 2001
From: simonmar <unknown>
Date: Wed, 1 Dec 1999 16:14:56 +0000
Subject: [PATCH] [project @ 1999-12-01 16:14:56 by simonmar] Add some tests
 for the new async exception behaviour.

---
 ghc/tests/concurrent/should_run/conc014.hs     |   17 ++++++++++++
 ghc/tests/concurrent/should_run/conc014.stdout |    2 ++
 ghc/tests/concurrent/should_run/conc015.hs     |   32 ++++++++++++++++++++++
 ghc/tests/concurrent/should_run/conc015.stdout |    2 ++
 ghc/tests/concurrent/should_run/conc016.hs     |   18 ++++++++++++
 ghc/tests/concurrent/should_run/conc016.stdout |    1 +
 ghc/tests/concurrent/should_run/conc017.hs     |   35 ++++++++++++++++++++++++
 ghc/tests/concurrent/should_run/conc017.stdout |    2 ++
 8 files changed, 109 insertions(+)
 create mode 100644 ghc/tests/concurrent/should_run/conc014.hs
 create mode 100644 ghc/tests/concurrent/should_run/conc014.stdout
 create mode 100644 ghc/tests/concurrent/should_run/conc015.hs
 create mode 100644 ghc/tests/concurrent/should_run/conc015.stdout
 create mode 100644 ghc/tests/concurrent/should_run/conc016.hs
 create mode 100644 ghc/tests/concurrent/should_run/conc016.stdout
 create mode 100644 ghc/tests/concurrent/should_run/conc017.hs
 create mode 100644 ghc/tests/concurrent/should_run/conc017.stdout

diff --git a/ghc/tests/concurrent/should_run/conc014.hs b/ghc/tests/concurrent/should_run/conc014.hs
new file mode 100644
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
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
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
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
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
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
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
index 0000000..7fca279
--- /dev/null
+++ b/ghc/tests/concurrent/should_run/conc017.stdout
@@ -0,0 +1,2 @@
+caught1: foo
+caught3: bar
-- 
1.7.10.4