base: Throw exceptions raised while closing finalized Handleswip/T21213

Fixes #21336.

2 files changed, 10 insertions, 4 deletions

diff --git a/libraries/base/GHC/IO/Handle/Internals.hs b/libraries/base/GHC/IO/Handle/Internals.hs
index cbd43c1666..1a5db1bc0a 100644
--- a/libraries/base/GHC/IO/Handle/Internals.hs
+++ b/libraries/base/GHC/IO/Handle/Internals.hs
@@ -440,9 +440,11 @@ recoveringEncode codec from to = go from to
 handleFinalizer :: FilePath -> MVar Handle__ -> IO ()
 handleFinalizer fp m = do
   handle_ <- takeMVar m
-  (handle_', _) <- hClose_help handle_
+  (handle_', mb_exc) <- hClose_help handle_
   putMVar m handle_'
-  return ()
+  case mb_exc of
+    Just exc -> throwIO exc
+    Nothing -> return ()
 
 -- ---------------------------------------------------------------------------
 -- Allocating buffers
diff --git a/libraries/base/GHC/TopHandler.hs b/libraries/base/GHC/TopHandler.hs
index 6a4e0325a6..adfa2cfa6f 100644
--- a/libraries/base/GHC/TopHandler.hs
+++ b/libraries/base/GHC/TopHandler.hs
@@ -231,8 +231,12 @@ calling the RTS, without iconv at all.
 -- an infinite loop).
 flushStdHandles :: IO ()
 flushStdHandles = do
-  hFlush stdout `catchAny` \_ -> return ()
-  hFlush stderr `catchAny` \_ -> return ()
+  hFlush stdout `catchException` handleExc
+  hFlush stderr `catchException` handleExc
+  where
+    handleExc se = do
+      handleFinalizerExc <- getFinalizerExceptionHandler
+      handleFinalizerExc se `catchException` (\(SomeException _) -> return ())
 
 safeExit, fastExit :: Int -> IO a
 safeExit = exitHelper useSafeExit