-sandboxIO :: MVar Status -> IO [HValue] -> IO Status
-sandboxIO statusMVar thing =
- withInterruptsSentTo
- (forkIO (do res <- Exception.try (rethrow thing)
- putMVar statusMVar (Complete res)))
- (takeMVar statusMVar)
+--
+-- Careful here: there may be ^C exceptions flying around, so we start
+-- the new thread blocked (forkIO inherits block from the parent,
+-- #1048), and unblock only while we execute the user's code. We
+-- can't afford to lose the final putMVar, otherwise deadlock
+-- ensues. (#1583, #1922, #1946)
+sandboxIO :: DynFlags -> MVar Status -> IO [HValue] -> IO Status
+sandboxIO dflags statusMVar thing =
+ block $ do -- fork starts blocked
+ id <- forkIO $ do res <- Exception.try (unblock $ rethrow dflags thing)
+ putMVar statusMVar (Complete res) -- empty: can't block
+ withInterruptsSentTo id $ takeMVar statusMVar
+