add tests for #1048

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

@@ -10,6 +10,7 @@ test('conc003', normal, compile_and_run, [''])
 test('conc006', normal, compile_and_run, [''])
 test('conc027', normal, compile_and_run, [''])
 test('conc051', normal, compile_and_run, [''])
+test('conc069', only_ways(['ghci','threaded1','threaded2']), compile_and_run, [''])
 
 # -----------------------------------------------------------------------------
 # These tests we only do for a full run

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

@@ -12,6 +12,7 @@ import Control.Exception
 
 main = do
   main_thread <- myThreadId
+  print =<< blocked
   m <- newEmptyMVar
   m2 <- newEmptyMVar
   forkIO (do takeMVar m
@@ -22,14 +23,15 @@ main = do
   ( do
     block (do
 	putMVar m ()
+        print =<< blocked
 	sum [1..10000] `seq` -- give 'foo' a chance to be raised
-  	  (unblock (myDelay 500000))
+  	  (unblock (do print =<< blocked; myDelay 500000))
 		`Control.Exception.catch` (\e -> putStrLn ("caught1: " ++ show e))
      )
     takeMVar m2
    )
     `Control.Exception.catch`
-    (\e -> putStrLn ("caught2: " ++ show e))
+    (\e -> do print =<< blocked; putStrLn ("caught2: " ++ show e))
 
 -- compensate for the fact that threadDelay is non-interruptible
 -- on Windows with the threaded RTS in 6.6.

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

+import Control.Concurrent
+import Control.Exception
+
+main = do
+  stat
+  m <- newEmptyMVar
+  forkIO (do stat; putMVar m ())
+  takeMVar m
+  block $ forkIO (do stat; putMVar m ())
+  takeMVar m
+  forkOS (do stat; putMVar m ())
+  takeMVar m
+  block $ forkOS (do stat; putMVar m ())
+  takeMVar m
+
+stat = do
+  x <- isCurrentThreadBound
+  y <- blocked
+  print (x,y)

testsuite/tests/ghc-regress/concurrent/should_run/conc069.stdout

+(True,False)
+(False,False)
+(False,True)
+(True,False)
+(True,True)