GitLab

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC

Commits:

91916079

by Sylvain Henry at 2026-03-13T15:11:43-04:00

T17912: wait for opener thread to block before killing it (#24739)

Instead of a fixed 1000ms delay, poll threadStatus until the opener
thread is in BlockedOnForeignCall, ensuring killThread only fires once
the thread is provably inside the blocking open() syscall. This prevents
the test from accidentally passing on Windows due to scheduling races.

2 changed files:

libraries/base/tests/IO/T17912.hs
libraries/base/tests/IO/all.T

Changes:

libraries/base/tests/IO/T17912.hs

@@ -6,6 +6,7 @@ import Control.Exception
  import System.IO
  import System.Exit
  import System.Process
 +import GHC.Conc (threadStatus, ThreadStatus(..), BlockReason(..))
  import GHC.IO.Handle.FD
  main = do
@@ -22,7 +23,14 @@ main = do
                  putMVar passed True
               else print e
               throwIO e
 -      threadDelay 1000
 +      let waitUntilBlocked = do
 +            st <- threadStatus opener
 +            case st of
 +              ThreadBlocked BlockedOnForeignCall -> return ()
 +              ThreadFinished -> return ()
 +              ThreadDied     -> return ()
 +              _              -> threadDelay 100 >> waitUntilBlocked
 +      waitUntilBlocked
        forkIO $ killThread opener
        forkIO $ do
          threadDelay (10^6)

libraries/base/tests/IO/all.T

@@ -182,7 +182,7 @@ test('T17414',
       compile_and_run, [''])
  test('T17510', expect_broken(17510), compile_and_run, [''])
  test('bytestringread001', extra_run_opts('test.data'), compile_and_run, [''])
 -test('T17912', [only_ways(['threaded1']), when(opsys('mingw32'),expect_broken(1))], compile_and_run, [''])
 +test('T17912', [only_ways(['threaded1']), when(opsys('mingw32'),expect_broken(17912))], compile_and_run, [''])
  test('T18832', only_ways(['threaded1']), compile_and_run, [''])
  test('mkdirExists', [exit_code(1), when(opsys('mingw32'), ignore_stderr)], compile_and_run, [''])