From 67330303714ab64751e538f318932a70c36392b6 Mon Sep 17 00:00:00 2001 From: Ben Gamari Date: Wed, 10 May 2023 14:20:46 -0400 Subject: base: Introduce printToHandleFinalizerExceptionHandler --- libraries/base/GHC/IO/Handle/Text.hs-boot | 8 ++++++++ libraries/base/GHC/IO/Handle/Types.hs-boot | 5 +++++ libraries/base/GHC/TopHandler.hs | 2 +- libraries/base/GHC/Weak.hs | 3 ++- libraries/base/GHC/Weak/Finalize.hs | 13 +++++++++++++ libraries/base/System/Mem/Weak.hs | 1 + libraries/base/changelog.md | 2 +- 7 files changed, 31 insertions(+), 3 deletions(-) create mode 100644 libraries/base/GHC/IO/Handle/Text.hs-boot create mode 100644 libraries/base/GHC/IO/Handle/Types.hs-boot diff --git a/libraries/base/GHC/IO/Handle/Text.hs-boot b/libraries/base/GHC/IO/Handle/Text.hs-boot new file mode 100644 index 0000000000..0d0186ee2e --- /dev/null +++ b/libraries/base/GHC/IO/Handle/Text.hs-boot @@ -0,0 +1,8 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module GHC.IO.Handle.Text ( hPutStrLn ) where + +import GHC.Base (String, IO) +import {-# SOURCE #-} GHC.IO.Handle.Types (Handle) + +hPutStrLn :: Handle -> String -> IO () diff --git a/libraries/base/GHC/IO/Handle/Types.hs-boot b/libraries/base/GHC/IO/Handle/Types.hs-boot new file mode 100644 index 0000000000..221396f24b --- /dev/null +++ b/libraries/base/GHC/IO/Handle/Types.hs-boot @@ -0,0 +1,5 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module GHC.IO.Handle.Types ( Handle ) where + +data Handle diff --git a/libraries/base/GHC/TopHandler.hs b/libraries/base/GHC/TopHandler.hs index a2354175e4..e3206517f2 100644 --- a/libraries/base/GHC/TopHandler.hs +++ b/libraries/base/GHC/TopHandler.hs @@ -84,7 +84,7 @@ runMainIO main = main_thread_id <- myThreadId weak_tid <- mkWeakThreadId main_thread_id - --setFinalizerExceptionHandler printToStderrFinalizerExceptionHandler + --setFinalizerExceptionHandler (printToHandleFinalizerExceptionHandler stderr) -- For the time being, we don't install any exception handler for -- Handle finalization. Instead, the user should set one manually. diff --git a/libraries/base/GHC/Weak.hs b/libraries/base/GHC/Weak.hs index 6d3dcb2d7f..80f3c4b731 100644 --- a/libraries/base/GHC/Weak.hs +++ b/libraries/base/GHC/Weak.hs @@ -31,7 +31,8 @@ module GHC.Weak ( -- 'setFinalizerExceptionHandler'. Note that any exceptions thrown by -- this handler will be ignored. setFinalizerExceptionHandler, - getFinalizerExceptionHandler + getFinalizerExceptionHandler, + printToHandleFinalizerExceptionHandler ) where import GHC.Base diff --git a/libraries/base/GHC/Weak/Finalize.hs b/libraries/base/GHC/Weak/Finalize.hs index 9a0aec9db6..87bc7b9f7e 100644 --- a/libraries/base/GHC/Weak/Finalize.hs +++ b/libraries/base/GHC/Weak/Finalize.hs @@ -11,6 +11,7 @@ module GHC.Weak.Finalize -- this handler will be ignored. setFinalizerExceptionHandler , getFinalizerExceptionHandler + , printToHandleFinalizerExceptionHandler -- * Internal , runFinalizerBatch ) where @@ -20,6 +21,8 @@ import GHC.Exception import GHC.IORef import {-# SOURCE #-} GHC.Conc.Sync (labelThreadByteArray#, myThreadId) import GHC.IO (catchException, unsafePerformIO) +import {-# SOURCE #-} GHC.IO.Handle.Types (Handle) +import {-# SOURCE #-} GHC.IO.Handle.Text (hPutStrLn) import GHC.Encoding.UTF8 (utf8EncodeByteArray#) data ByteArray = ByteArray ByteArray# @@ -79,3 +82,13 @@ getFinalizerExceptionHandler = readIORef finalizerExceptionHandler -- @since 4.18.0.0 setFinalizerExceptionHandler :: (SomeException -> IO ()) -> IO () setFinalizerExceptionHandler = writeIORef finalizerExceptionHandler + +-- | An exception handler for 'Handle' finalization that prints the error to +-- the given 'Handle', but doesn't rethrow it. +-- +-- @since 4.18.0.0 +printToHandleFinalizerExceptionHandler :: Handle -> SomeException -> IO () +printToHandleFinalizerExceptionHandler hdl se = + hPutStrLn hdl msg `catchException` (\(SomeException _) -> return ()) + where + msg = "Exception during weak pointer finalization (ignored): " ++ displayException se ++ "\n" diff --git a/libraries/base/System/Mem/Weak.hs b/libraries/base/System/Mem/Weak.hs index 9792a429cd..00b2742c86 100644 --- a/libraries/base/System/Mem/Weak.hs +++ b/libraries/base/System/Mem/Weak.hs @@ -71,6 +71,7 @@ module System.Mem.Weak ( -- this handler will be ignored. setFinalizerExceptionHandler, getFinalizerExceptionHandler, + printToHandleFinalizerExceptionHandler, -- * A precise semantics diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md index c11265c0c1..afc4e26b68 100644 --- a/libraries/base/changelog.md +++ b/libraries/base/changelog.md @@ -15,7 +15,7 @@ ([CLC proposal #98](https://github.com/haskell/core-libraries-committee/issues/98)) * Add `Data.Functor.unzip` ([CLC proposal #88](https://github.com/haskell/core-libraries-committee/issues/88)) * Add `System.Mem.Weak.{get,set}FinalizerExceptionHandler`, which allows the user to set the global handler invoked by when a `Weak` pointer finalizer throws an exception. ([CLC proposal #126](https://github.com/haskell/core-libraries-committee/issues/126)) - * Add `System.Mem.Weak.printToStderrFinalizerExceptionHandler`, which can be used with `setFinalizerExceptionHandler` to print exceptions thrown by finalizers to `stderr`. ([CLC proposal #126](https://github.com/haskell/core-libraries-committee/issues/126)) + * Add `System.Mem.Weak.printToHandleFinalizerExceptionHandler`, which can be used with `setFinalizerExceptionHandler` to print exceptions thrown by finalizers to the given `Handle`. ([CLC proposal #126](https://github.com/haskell/core-libraries-committee/issues/126)) * Implement more members of `instance Foldable (Compose f g)` explicitly. ([CLC proposal #57](https://github.com/haskell/core-libraries-committee/issues/57)) * Add `Eq` and `Ord` instances for `SSymbol`, `SChar`, and `SNat`. -- cgit v1.2.1