summaryrefslogtreecommitdiff
path: root/testsuite/tests/concurrent/should_run/conc034.hs
diff options
context:
space:
mode:
Diffstat (limited to 'testsuite/tests/concurrent/should_run/conc034.hs')
-rw-r--r--testsuite/tests/concurrent/should_run/conc034.hs31
1 files changed, 31 insertions, 0 deletions
diff --git a/testsuite/tests/concurrent/should_run/conc034.hs b/testsuite/tests/concurrent/should_run/conc034.hs
new file mode 100644
index 0000000000..4101212ad1
--- /dev/null
+++ b/testsuite/tests/concurrent/should_run/conc034.hs
@@ -0,0 +1,31 @@
+import Control.Concurrent
+import Control.Exception
+import Foreign
+
+import System.IO (hFlush,stdout)
+
+import Prelude hiding (catch)
+
+-- !!! Try to get two threads into a knot depending on each other.
+
+-- This should result in the main thread being sent a NonTermination
+-- exception (in GHC 5.02, the program is terminated with "no threads
+-- to run" instead).
+
+main = do
+ Foreign.newStablePtr stdout
+ -- HACK, because when these two threads get blocked on each other,
+ -- there's nothing keeping stdout alive so it will get finalized.
+ -- SDM 12/3/2004
+ let a = last ([1..10000] ++ [b])
+ b = last ([2..10000] ++ [a])
+ -- we have to be careful to ensure that the strictness analyser
+ -- can't see that a and b are both bottom, otherwise the
+ -- simplifier will go to town here, resulting in something like
+ -- a = a and b = a.
+ forkIO (print a `catch` \NonTermination -> return ())
+ -- we need to catch in the child thread too, because it might
+ -- get sent the NonTermination exception first.
+ r <- Control.Exception.try (print b)
+ print (r :: Either NonTermination ())
+