GitLab

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

Commits:

037a80dc

by Tom McLaughlin at 2026-05-28T12:24:36-04:00

Event/Windows.hsc: rethrow exceptions in overlapped IO

This prevents the WinIO manager from swallowing exceptions in overlapped IO. It
was added to make WinIO support possible in the `network` library. See
https://gitlab.haskell.org/ghc/ghc/-/issues/27283.

We also bump __IO_MANAGER_WINIO__ to 2 so libraries can gate on this using CPP.

3 changed files:

+ changelog.d/windows-rethrow-overlapped-exception
compiler/GHC/SysTools/Cpp.hs
libraries/ghc-internal/src/GHC/Internal/Event/Windows.hsc

Changes:

changelog.d/windows-rethrow-overlapped-exception

 +section: rts
 +synopsis: Rethrow exceptions in overlapped IO when using the WinIO IO manager.
 +issues: #27283
 +mrs: !15887
++
 +description: {
 +  This change was made to support WinIO in the network library; see https://github.com/haskell/network/issues/602.
 +}

compiler/GHC/SysTools/Cpp.hs

@@ -148,7 +148,7 @@ doCpp logger tmpfs dflags unit_env opts input_fn output_fn = do
          -- and BUILD is the same as our HOST.
      let io_manager_defs =
 -          [ "-D__IO_MANAGER_WINIO__=1" | isWindows ] ++
 +          [ "-D__IO_MANAGER_WINIO__=2" | isWindows ] ++
            [ "-D__IO_MANAGER_MIO__=1"               ]
      let sse_defs =

libraries/ghc-internal/src/GHC/Internal/Event/Windows.hsc

@@ -690,7 +690,11 @@ withOverlappedEx mgr fname h async offset startCB completionCB = do
                               -- can go into an unbounded alertable wait.
                               delay <- runExpiredTimeouts mgr
                               registerAlertableWait delay
 -                        return $ IOFailed Nothing
 +                        -- Re-throw the original exception rather than
 +                        -- returning IOFailed. This ensures that async
 +                        -- exceptions (e.g. Timeout from System.Timeout)
 +                        -- propagate correctly to their handlers.
 +                        E.throw e
          let runner = do debugIO $ (dbgMsg ":: waiting ") ++ " | "  ++ show lpol
                          res <- readMVar signal `catch` cancel
                          debugIO $ dbgMsg ":: signaled "