Duncan Coutts pushed to branch wip/io-manager-deadlock-detection at Glasgow Haskell Compiler / GHC Commits: 05ac0a02 by Duncan Coutts at 2025-09-13T02:19:17+01:00 Add a test for deadlock detection, issue #26408 - - - - - 3 changed files: - + testsuite/tests/rts/T26408.hs - + testsuite/tests/rts/T26408.stderr - testsuite/tests/rts/all.T Changes: ===================================== testsuite/tests/rts/T26408.hs ===================================== @@ -0,0 +1,43 @@ +import Control.Concurrent +import Control.Concurrent.STM +import Control.Exception +import Control.Monad + +-- | Test to make sure that deadlock detection works even when there are other +-- unrelated threads that are blocked on I\/O or timeouts. +-- Historically however this did affect things in the non-threaded RTS which +-- would only do deadlock detection if there were no runnable threads /and/ +-- no pending I\/O. See https://gitlab.haskell.org/ghc/ghc/-/issues/26408 +main :: IO () +main = do + + -- Set up two threads that are deadlocked on each other + aDone <- newTVarIO False + bDone <- newTVarIO False + let blockingThread theirDone ourDone = + atomically $ do + done <- readTVar theirDone + guard done + writeTVar ourDone True + _ <- forkIO (blockingThread bDone aDone) + _ <- forkIO (blockingThread aDone bDone) + + -- Set up another thread that is blocked on a long timeout. + -- + -- We use a timeout rather than I/O as it's more portable, whereas I/O waits + -- are different between posix and windows I/O managers. + -- + -- One gotcha is that when the timeout completes then the deadlock will be + -- detected again (since the bug is about I/O or timeouts masking deadlock + -- detection). So for a reliable test the timeout used here must be longer + -- than the test framework's own timeout. So we use maxBound, and we adjust + -- the test framework's timeout to be short (see run_timeout_multiplier). + _ <- forkIO (threadDelay maxBound) + + -- Wait on the deadlocked threads to terminate. We now expect that the threads + -- that are deadlocked are detected as such and an exception is raised. + -- Note that if this fails, the test itself will effectively deadlock and + -- will rely on the test framework's timeout. + atomically $ do + status <- mapM readTVar [aDone, bDone] + guard (or status) ===================================== testsuite/tests/rts/T26408.stderr ===================================== @@ -0,0 +1,3 @@ +T26408: Uncaught exception ghc-internal:GHC.Internal.IO.Exception.BlockedIndefinitelyOnSTM: + +thread blocked indefinitely in an STM transaction ===================================== testsuite/tests/rts/all.T ===================================== @@ -647,3 +647,5 @@ test('T22859', when(arch('wasm32'), skip), omit_ways(llvm_ways)], compile_and_run, ['-with-rtsopts -A8K']) + +test('T26408', [exit_code(1), run_timeout_multiplier(0.1)], compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/05ac0a020dad30c7505b0243ccac3133... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/05ac0a020dad30c7505b0243ccac3133... You're receiving this email because of your account on gitlab.haskell.org.