diff options
-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 |