summaryrefslogtreecommitdiff
path: root/testsuite/tests/concurrent/should_run/conc064.hs
diff options
context:
space:
mode:
Diffstat (limited to 'testsuite/tests/concurrent/should_run/conc064.hs')
-rw-r--r--testsuite/tests/concurrent/should_run/conc064.hs30
1 files changed, 30 insertions, 0 deletions
diff --git a/testsuite/tests/concurrent/should_run/conc064.hs b/testsuite/tests/concurrent/should_run/conc064.hs
new file mode 100644
index 0000000000..d37387c601
--- /dev/null
+++ b/testsuite/tests/concurrent/should_run/conc064.hs
@@ -0,0 +1,30 @@
+-- test for bug #1067
+
+import Control.Concurrent
+import Control.Exception
+
+main = do
+ master <- myThreadId
+ test master 10
+ -- make sure we catch a final NonTermination exception to get
+ -- a consistent result.
+ threadDelay (10 * one_second)
+
+test tid 0 = return ()
+test tid n = do
+ e <- try threads
+ case e of
+ Left NonTermination -> test tid (n-1)
+ Right _ -> return ()
+ where
+ threads = do sequence $ replicate 3 $
+ forkIO $ do t <- myThreadId
+ --putStrLn ("Start " ++ show t)
+ threadDelay one_second
+ --putStrLn ("End " ++ show t)
+ throwTo tid NonTermination
+ --putStrLn ("Thrown " ++ show t)
+ threadDelay (10 * one_second)
+
+one_second :: Int
+one_second = 100000