Fix issue with BlockdIndefinitely exeptions killing the runner [batte…

…rseapower#1]

core/Test/Framework/Runners/ThreadPool.hs

@@ -8,6 +8,8 @@ import Control.Monad
 
 import qualified Data.IntMap as IM
 
+import Foreign.StablePtr
+
 
 data WorkerEvent token a = WorkerTermination
                          | WorkerItem token a
@@ -32,6 +34,21 @@ executeOnPool n actions = do
 
     -- Spawn workers
     forM_ [1..n] (const $ forkIO $ poolWorker input_chan output_chan)
+
+    -- Short version: make sure we do the right thing if a test blocks on dead
+    -- MVars or TVars.
+    -- Long version: GHC is clever enough to throw an exception (BlockedOnDeadMVar
+    -- or BlockedIndefinitely) when a thread is waiting for a MVar or TVar that can't
+    -- be written to. However, it doesn't know anything about the handlers for those
+    -- exceptions. Therefore, when a worker runs a test that causes this exception,
+    -- since the main thread is blocking on the worker, the main thread gets the
+    -- exception too despite the fact that the main thread will be runnable as soon
+    -- as the worker catches its own exception. The below makes sure the main thread
+    -- is always reachable by the GC, which is the mechanism for finding threads
+    -- that are unrunnable.
+    -- See also the ticket where SimonM (semi-cryptically) explains this:
+    -- http://hackage.haskell.org/trac/ghc/ticket/3291
+    stablePtr <- myThreadId >>= newStablePtr
 
     -- Return the results generated by the worker threads lazily and in
     -- the same order as we got the inputs