Deadlock in the threaded RTS
The following program deadlocks with high probability:
-- ghc -rtsopts -threaded -debug performGC.hs -- ./performGC 1000 +RTS -qg -N2 -- -qg turns off parallel GC, needed to trigger the bug -- -N2 or greater is needed module Main (main) where import System.Environment import Control.Concurrent import Control.Exception import Control.Monad import System.Random import System.Mem import qualified Data.Set as Set main = do [n] <- getArgs forkIO $ doSomeWork forM [1..read n] $ \n -> do print n; threadDelay 1000; performMinorGC doSomeWork :: IO () doSomeWork = forever $ do ns <- replicateM 10000 randomIO :: IO [Int] ms <- replicateM 1000 randomIO let set = Set.fromList ns elems = filter (`Set.member` set) ms evaluate $ sum elems
There are a few ways that this bug can be triggered:
- At shutdown, when there are other threads still running. This is how we first encountered it.
performGC, as above. I think it's necessary to call it from a bound thread (e.g. the main thread) to get bad things to happen.
- I think
forkProcessmight also trigger it, but I haven't observed it.
I'm working on a fix.