[commit: testsuite] master: add a test for #4988 (a11fac2)

[Simon Marlow]

Repository : ssh://darcs.haskell.org//srv/darcs/testsuite

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/a11fac2177121a879a603b9653e49b0e71e98c91

>---------------------------------------------------------------

commit a11fac2177121a879a603b9653e49b0e71e98c91
Author: Simon Marlow <marlowsd at gmail.com>
Date:   Wed Aug 31 22:56:51 2011 +0100

    add a test for #4988

>---------------------------------------------------------------

 tests/concurrent/should_run/all.T          |    1 +
 tests/concurrent/should_run/conc073.hs     |   21 +++++++++++++++++++++
 tests/concurrent/should_run/conc073.stdout |    1 +
 3 files changed, 23 insertions(+), 0 deletions(-)

diff --git a/tests/concurrent/should_run/all.T b/tests/concurrent/should_run/all.T
index ed3c55d..0be9db4 100644
--- a/tests/concurrent/should_run/all.T
+++ b/tests/concurrent/should_run/all.T
@@ -19,6 +19,7 @@ test('conc070', only_threaded_ways, compile_and_run, [''])
 
 test('conc071', omit_ways(['threaded2']), compile_and_run, [''])
 test('conc072', only_ways(['threaded2']), compile_and_run, [''])
+test('conc073', normal, compile_and_run, [''])
 
 test('1980', normal, compile_and_run, [''])
 test('2910', normal, compile_and_run, [''])
diff --git a/tests/concurrent/should_run/conc073.hs b/tests/concurrent/should_run/conc073.hs
new file mode 100644
index 0000000..66bbe8e
--- /dev/null
+++ b/tests/concurrent/should_run/conc073.hs
@@ -0,0 +1,21 @@
+import Control.Exception
+import Control.Concurrent
+import Prelude hiding (catch)
+
+main = do
+  m1 <- newEmptyMVar
+  m2 <- newEmptyMVar
+  t <- forkIO $ do
+    mask_ $ return ()
+    throwIO (ErrorCall "test") `catch`
+       \e -> do
+         let _ = e::SomeException
+         print =<< getMaskingState
+         putMVar m1 ()
+         takeMVar m2
+  takeMVar m1
+  killThread t
+   -- in GHC 7.2 and earlier this call will deadlock due to bug #4988.
+   -- However, the RTS will resurrect the child thread, and in doing
+   -- so will unblock the main thread, so the main thread doesn't get
+   -- a BlockedIndefinitely exception.
diff --git a/tests/concurrent/should_run/conc073.stdout b/tests/concurrent/should_run/conc073.stdout
new file mode 100644
index 0000000..a5832ac
--- /dev/null
+++ b/tests/concurrent/should_run/conc073.stdout
@@ -0,0 +1 @@
+MaskedInterruptible