Duncan Coutts pushed to branch wip/io-manager-deadlock-detection at Glasgow Haskell Compiler / GHC
Commits:
-
58cdfab9
by Duncan Coutts at 2025-09-12T12:34:07+01:00
3 changed files:
Changes:
| 1 | +import Control.Concurrent
|
|
| 2 | +import Control.Concurrent.STM
|
|
| 3 | +import Control.Monad
|
|
| 4 | + |
|
| 5 | +-- | Test to make sure that deadlock detection works even when there are other
|
|
| 6 | +-- unrelated threads that are blocked on I\/O (or timeouts).
|
|
| 7 | +-- Historically however this did affect things in the non-threaded RTS which
|
|
| 8 | +-- would only do deadlock detection if there were no runnable threads /and/
|
|
| 9 | +-- no pending I\/O. See <https://gitlab.haskell.org/ghc/ghc/-/issues/26408>
|
|
| 10 | +main :: IO ()
|
|
| 11 | +main = do
|
|
| 12 | +
|
|
| 13 | + -- Set up two threads that are blocked on each other
|
|
| 14 | + aDone <- newTVarIO False
|
|
| 15 | + bDone <- newTVarIO False
|
|
| 16 | + let blockingThread theirDone ourDone =
|
|
| 17 | + atomically $ do
|
|
| 18 | + done <- readTVar theirDone
|
|
| 19 | + guard done
|
|
| 20 | + writeTVar ourDone True
|
|
| 21 | + _ <- forkIO (blockingThread bDone aDone)
|
|
| 22 | + _ <- forkIO (blockingThread aDone bDone)
|
|
| 23 | + |
|
| 24 | + -- Set up another thread that is blocked on I/O
|
|
| 25 | + _ <- forkIO $ threadWaitRead 0
|
|
| 26 | + |
|
| 27 | + -- Wait on the deadlocked threads to terminate. We now expect that the threads
|
|
| 28 | + -- that are deadlocked are detected as such and an exception is raised.
|
|
| 29 | + -- Note that if this fails, this test may itself deadlock and rely on the
|
|
| 30 | + -- test framework's timeout.
|
|
| 31 | + atomically $ do
|
|
| 32 | + status <- mapM readTVar [aDone, bDone]
|
|
| 33 | + guard (or status) |
| 1 | +T26408: Uncaught exception ghc-internal:GHC.Internal.IO.Exception.BlockedIndefinitelyOnSTM:
|
|
| 2 | + |
|
| 3 | +thread blocked indefinitely in an STM transaction |
| ... | ... | @@ -647,3 +647,5 @@ test('T22859', |
| 647 | 647 | when(arch('wasm32'), skip),
|
| 648 | 648 | omit_ways(llvm_ways)],
|
| 649 | 649 | compile_and_run, ['-with-rtsopts -A8K'])
|
| 650 | + |
|
| 651 | +test('T26408', [exit_code(1)], compile_and_run, ['']) |