Hanging STM transaction with orElse on writeTVar
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 "))))"
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).
-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