diff options
author | Ben Gamari <ben@smart-cactus.org> | 2022-05-03 15:29:04 -0400 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2022-05-03 17:38:45 -0400 |
commit | 2d12690df822e5d94fe6ea6a04b0fe19f1f271d2 (patch) | |
tree | 105122c8b39292beee9e1a38a5a52e8dcf684855 | |
parent | cf9125e0867347e3c8fb237d9fc076461166c60d (diff) | |
download | haskell-2d12690df822e5d94fe6ea6a04b0fe19f1f271d2.tar.gz |
base: Throw exceptions raised while closing finalized Handleswip/T21213
Fixes #21336.
-rw-r--r-- | libraries/base/GHC/IO/Handle/Internals.hs | 6 | ||||
-rw-r--r-- | libraries/base/GHC/TopHandler.hs | 8 |
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 |