[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

+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))
+

ghc/tests/concurrent/should_run/conc014.stdout

+done.
+caught: foo

ghc/tests/concurrent/should_run/conc015.hs

+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))

ghc/tests/concurrent/should_run/conc015.stdout

+caught1: foo
+caught2: bar

ghc/tests/concurrent/should_run/conc016.hs

+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"

ghc/tests/concurrent/should_run/conc016.stdout

+ok

ghc/tests/concurrent/should_run/conc017.hs

+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))

ghc/tests/concurrent/should_run/conc017.stdout

+caught1: foo
+caught3: bar