GitLab

In the following program the main thread's atomically hangs in the second iteration, although no other threads are running (and the transaction would have no reason to retry).

import Control.Concurrent
import Control.Concurrent.STM
import Debug.Trace

main :: IO ()
main = (`mapM_` [1..1000]) $ \_ -> do
  traceEventIO "(((("

  x <- newTVarIO False

  forkIO $ atomically $ writeTVar x True

  traceEventIO "----"

  atomically $ do  -- hangs in the second iteration
    _ <- readTVar x
    writeTVar x True `orElse` return ()

  threadDelay 100000
  traceEventIO "))))"

Obviously, using orElse on writeTVar makes no sense, the code here is the result of boiling down a much bigger program.

$ ghc -debug Bug.hs
[1 of 1] Compiling Main             ( Bug.hs, Bug.o )
Linking Bug ...

$ ./Bug +RTS -v
created capset 0 of type 2
created capset 1 of type 3
cap 0: initialised
assigned cap 0 to capset 0
assigned cap 0 to capset 1
cap 0: created thread 1
cap 0: running thread 1 (ThreadRunGHC)
cap 0: ((((
cap 0: created thread 2
cap 0: ----
cap 0: thread 1 stopped (blocked on a delay operation)
cap 0: running thread 2 (ThreadRunGHC)
cap 0: thread 2 stopped (finished)
cap 0: running thread 1 (ThreadRunGHC)
cap 0: thread 1 stopped (yielding)
cap 0: running thread 1 (ThreadRunGHC)
cap 0: ))))
cap 0: ((((
cap 0: created thread 3
cap 0: ----
cap 0: thread 1 stopped (yielding)
cap 0: running thread 3 (ThreadRunGHC)
cap 0: thread 3 stopped (finished)
cap 0: running thread 1 (ThreadRunGHC)

At this point the program hangs and uses 100% CPU. Only the main thread (1) is running (2 and 3 finished). It is past the ----, but hasn't reached threadDelay yet (no blocked on a delay operation in the second iteration). So it must be working on the atomically block in between.

This is perfectly reproducible (exact same result on two different machines, tested several times).

Compiling with -fno-omit-yields (as suggested in https://downloads.haskell.org/~ghc/8.6.5/docs/html/users_guide/bugs.html#bugs-in-ghc, which refers to #367) makes no difference. This also seems different to #15975, where the problem appears to be a failure to yield in between transactions. Removing either the readTVar x or the `orElse` return () bit makes all 1000 iterations go through without hanging.

$ ghc --version
The Glorious Glasgow Haskell Compilation System, version 8.6.5