tests for #1047

testsuite/tests/ghc-regress/concurrent/should_run/all.T

@@ -147,3 +147,6 @@ test('conc062', normal, compile_and_run, ['-package stm'])
 test('conc063', exit_code(1), compile_and_run, ['-package stm'])
 
 test('conc064', normal, compile_and_run, [''])
+
+test('conc065', ignore_output, compile_and_run, [''])
+test('conc066', ignore_output, compile_and_run, [''])

testsuite/tests/ghc-regress/concurrent/should_run/conc065.hs

+-- Test for bug #1047
+
+import Control.Concurrent
+import Control.Exception
+
+-- This loop spends most of its time printing stuff, and very occasionally
+-- pops outside 'block'.  This test ensures that an thread trying to
+-- throwTo this thread will eventually succeed.
+loop = block (print "alive") >> loop
+
+main = do tid <- forkIO loop
+          threadDelay 1
+          killThread tid

testsuite/tests/ghc-regress/concurrent/should_run/conc066.hs

+-- Test for bug #1047
+
+import Control.Concurrent
+import Control.Exception
+
+-- This loop spends most of its time printing stuff, and very occasionally
+-- executes 'unblock (return ())'.  This test ensures that a thread waiting
+-- to throwTo this thread is not blocked indefinitely.
+loop = do unblock (return ()); print "alive"; loop
+
+main = do tid <- forkIO (block loop)
+          yield
+          killThread tid