diff options
| -rw-r--r-- | docs/users_guide/9.6.1-notes.rst | 4 | ||||
| -rw-r--r-- | libraries/base/GHC/Weak.hs | 33 | ||||
| -rw-r--r-- | libraries/base/GHC/Weak/Finalize.hs | 68 | ||||
| -rw-r--r-- | libraries/base/base.cabal | 1 | ||||
| -rw-r--r-- | libraries/base/changelog.md | 5 | ||||
| -rw-r--r-- | libraries/base/tests/T13167.stderr | 4 | ||||
| -rw-r--r-- | libraries/base/tests/all.T | 7 | ||||
| -rw-r--r-- | rts/Prelude.h | 3 | ||||
| -rw-r--r-- | rts/package.conf.in | 4 | ||||
| -rw-r--r-- | rts/rts.cabal.in | 4 | ||||
| -rw-r--r-- | rts/win32/libHSbase.def | 2 |
11 files changed, 104 insertions, 31 deletions
diff --git a/docs/users_guide/9.6.1-notes.rst b/docs/users_guide/9.6.1-notes.rst index c5580b5abe..14bf7e2994 100644 --- a/docs/users_guide/9.6.1-notes.rst +++ b/docs/users_guide/9.6.1-notes.rst @@ -15,6 +15,10 @@ Compiler ``base`` library ~~~~~~~~~~~~~~~~ +- Exceptions thrown by weak pointer finalizers are now caught and reported + via a global exception handler. By default this handler reports the error + to ``stderr`` although this can be changed using + ``GHC.Weak.Finalize.setFinalizerExceptionHandler``. ``ghc-prim`` library ~~~~~~~~~~~~~~~~~~~~ diff --git a/libraries/base/GHC/Weak.hs b/libraries/base/GHC/Weak.hs index 5044d8f8aa..9eff415c99 100644 --- a/libraries/base/GHC/Weak.hs +++ b/libraries/base/GHC/Weak.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE BangPatterns #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE UnboxedTuples #-} @@ -25,10 +24,18 @@ module GHC.Weak ( mkWeak, deRefWeak, finalize, - runFinalizerBatch + + -- * Handling exceptions + -- | When an exception is thrown by a finalizer called by the + -- garbage collector, GHC calls a global handler which can be set with + -- 'setFinalizerExceptionHandler'. Note that any exceptions thrown by + -- this handler will be ignored. + setFinalizerExceptionHandler, + getFinalizerExceptionHandler ) where import GHC.Base +import GHC.Weak.Finalize {-| A weak pointer object with a key and a value. The value has type @v@. @@ -131,25 +138,3 @@ Instance Eq (Weak v) where (Weak w1) == (Weak w2) = w1 `sameWeak#` w2 -} - --- run a batch of finalizers from the garbage collector. We're given --- an array of finalizers and the length of the array, and we just --- call each one in turn. --- --- the IO primitives are inlined by hand here to get the optimal --- code (sigh) --SDM. - -runFinalizerBatch :: Int -> Array# (State# RealWorld -> State# RealWorld) - -> IO () -runFinalizerBatch (I# n) arr = - let go m = IO $ \s -> - case m of - 0# -> (# s, () #) - _ -> let !m' = m -# 1# in - case indexArray# arr m' of { (# io #) -> - case catch# (\p -> (# io p, () #)) - (\_ s'' -> (# s'', () #)) s of { - (# s', _ #) -> unIO (go m') s' - }} - in - go n diff --git a/libraries/base/GHC/Weak/Finalize.hs b/libraries/base/GHC/Weak/Finalize.hs new file mode 100644 index 0000000000..09308fb3d3 --- /dev/null +++ b/libraries/base/GHC/Weak/Finalize.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE Unsafe #-} + +module GHC.Weak.Finalize + ( -- * Handling exceptions + -- | When an exception is thrown by a finalizer called by the + -- garbage collector, GHC calls a global handler which can be set with + -- 'setFinalizerExceptionHandler'. Note that any exceptions thrown by + -- this handler will be ignored. + setFinalizerExceptionHandler + , getFinalizerExceptionHandler + -- * Internal + , runFinalizerBatch + ) where + +import GHC.Base +import GHC.Exception +import GHC.IORef +import GHC.IO (catchException, unsafePerformIO) + +-- | Run a batch of finalizers from the garbage collector. We're given +-- an array of finalizers and the length of the array, and we just +-- call each one in turn. +runFinalizerBatch :: Int + -> Array# (State# RealWorld -> State# RealWorld) + -> IO () +runFinalizerBatch (I# n) arr = + go n + where + getFinalizer :: Int# -> IO () + getFinalizer i = + case indexArray# arr i of + (# io #) -> IO $ \s -> + case io s of + s' -> (# s', () #) + + go :: Int# -> IO () + go 0# = return () + go i = do + let i' = i -# 1# + let finalizer = getFinalizer i' + finalizer `catchException` handleExc + go i' + + handleExc :: SomeException -> IO () + handleExc se = do + handleFinalizerExc <- getFinalizerExceptionHandler + handleFinalizerExc se `catchException` (\(SomeException _) -> return ()) + +finalizerExceptionHandler :: IORef (SomeException -> IO ()) +finalizerExceptionHandler = unsafePerformIO $ newIORef (const $ return ()) +{-# NOINLINE finalizerExceptionHandler #-} + +-- | Get the global action called to report exceptions thrown by weak pointer +-- finalizers to the user. +-- +-- @since 4.18.0.0 +getFinalizerExceptionHandler :: IO (SomeException -> IO ()) +getFinalizerExceptionHandler = readIORef finalizerExceptionHandler + +-- | Set the global action called to report exceptions thrown by weak pointer +-- finalizers to the user. +-- +-- @since 4.18.0.0 +setFinalizerExceptionHandler :: (SomeException -> IO ()) -> IO () +setFinalizerExceptionHandler = writeIORef finalizerExceptionHandler diff --git a/libraries/base/base.cabal b/libraries/base/base.cabal index e0cd8f4197..7ecc17b3fa 100644 --- a/libraries/base/base.cabal +++ b/libraries/base/base.cabal @@ -285,6 +285,7 @@ Library GHC.TypeNats.Internal GHC.Unicode GHC.Weak + GHC.Weak.Finalize GHC.Word Numeric Numeric.Natural diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md index 76c4731b01..3762ebf4df 100644 --- a/libraries/base/changelog.md +++ b/libraries/base/changelog.md @@ -2,6 +2,11 @@ ## 4.18.0.0 *TBA* + * Exceptions thrown by weak pointer finalizers are now reported via a global + exception handler. + * Add `GHC.Weak.Finalize.{get,set}FinalizerExceptionHandler` which the user to + override the above-mentioned handler. + ## 4.17.0.0 *TBA* * Add explicitly bidirectional `pattern TypeRep` to `Type.Reflection`. diff --git a/libraries/base/tests/T13167.stderr b/libraries/base/tests/T13167.stderr new file mode 100644 index 0000000000..ecb0102c0b --- /dev/null +++ b/libraries/base/tests/T13167.stderr @@ -0,0 +1,4 @@ +Exception during Weak# finalization (ignored): failed +Exception during Weak# finalization (ignored): failed +Exception during Weak# finalization (ignored): failed +Exception during Weak# finalization (ignored): failed diff --git a/libraries/base/tests/all.T b/libraries/base/tests/all.T index d39b41b92a..fbc3b69dcf 100644 --- a/libraries/base/tests/all.T +++ b/libraries/base/tests/all.T @@ -250,7 +250,12 @@ test('T3474', test('T14425', normal, compile_and_run, ['']) test('T10412', normal, compile_and_run, ['']) test('T13896', normal, compile_and_run, ['']) -test('T13167', fragile_for(16536, concurrent_ways), compile_and_run, ['']) +# On Windows this test is fragile using the old MIO IO manager due to an +# apparent flushing bug. +test('T13167', + [when(opsys('mingw32'), only_ways(['winio', 'winio_threaded'])), + fragile_for(16536, concurrent_ways)], + compile_and_run, ['']) test('T15349', [exit_code(1), expect_broken_for(15349, ['ghci'])], compile_and_run, ['']) test('T16111', exit_code(1), compile_and_run, ['']) test('T16943a', normal, compile_and_run, ['']) diff --git a/rts/Prelude.h b/rts/Prelude.h index 5f1e070e33..2a935f9f90 100644 --- a/rts/Prelude.h +++ b/rts/Prelude.h @@ -34,6 +34,7 @@ PRELUDE_CLOSURE(ghczmprim_GHCziTypes_True_closure); PRELUDE_CLOSURE(ghczmprim_GHCziTypes_False_closure); PRELUDE_CLOSURE(base_GHCziPack_unpackCString_closure); PRELUDE_CLOSURE(base_GHCziWeak_runFinalizzerBatch_closure); +PRELUDE_CLOSURE(base_GHCziWeakziFinalizze_runFinalizzerBatch_closure); #if defined(IN_STG_CODE) extern W_ ZCMain_main_closure[]; @@ -91,7 +92,7 @@ PRELUDE_INFO(base_GHCziStable_StablePtr_con_info); #define True_closure DLL_IMPORT_DATA_REF(ghczmprim_GHCziTypes_True_closure) #define False_closure DLL_IMPORT_DATA_REF(ghczmprim_GHCziTypes_False_closure) #define unpackCString_closure DLL_IMPORT_DATA_REF(base_GHCziPack_unpackCString_closure) -#define runFinalizerBatch_closure DLL_IMPORT_DATA_REF(base_GHCziWeak_runFinalizzerBatch_closure) +#define runFinalizerBatch_closure DLL_IMPORT_DATA_REF(base_GHCziWeakziFinalizze_runFinalizzerBatch_closure) #define mainIO_closure (&ZCMain_main_closure) #define runSparks_closure DLL_IMPORT_DATA_REF(base_GHCziConcziSync_runSparks_closure) diff --git a/rts/package.conf.in b/rts/package.conf.in index cb5a436f5c..248b6b9c57 100644 --- a/rts/package.conf.in +++ b/rts/package.conf.in @@ -89,7 +89,7 @@ ld-options: , "-Wl,-u,_ghczmprim_GHCziTypes_True_closure" , "-Wl,-u,_ghczmprim_GHCziTypes_False_closure" , "-Wl,-u,_base_GHCziPack_unpackCString_closure" - , "-Wl,-u,_base_GHCziWeak_runFinalizzerBatch_closure" + , "-Wl,-u,_base_GHCziWeakziFinalizze_runFinalizzerBatch_closure" , "-Wl,-u,_base_GHCziIOziException_stackOverflow_closure" , "-Wl,-u,_base_GHCziIOziException_heapOverflow_closure" , "-Wl,-u,_base_GHCziIOziException_allocationLimitExceeded_closure" @@ -202,7 +202,7 @@ ld-options: , "-Wl,-u,ghczmprim_GHCziTypes_True_closure" , "-Wl,-u,ghczmprim_GHCziTypes_False_closure" , "-Wl,-u,base_GHCziPack_unpackCString_closure" - , "-Wl,-u,base_GHCziWeak_runFinalizzerBatch_closure" + , "-Wl,-u,base_GHCziWeakziFinalizze_runFinalizzerBatch_closure" , "-Wl,-u,base_GHCziIOziException_stackOverflow_closure" , "-Wl,-u,base_GHCziIOziException_heapOverflow_closure" , "-Wl,-u,base_GHCziIOziException_allocationLimitExceeded_closure" diff --git a/rts/rts.cabal.in b/rts/rts.cabal.in index cc449ee522..96989ee750 100644 --- a/rts/rts.cabal.in +++ b/rts/rts.cabal.in @@ -257,7 +257,7 @@ library "-Wl,-u,_ghczmprim_GHCziTypes_True_closure" "-Wl,-u,_ghczmprim_GHCziTypes_False_closure" "-Wl,-u,_base_GHCziPack_unpackCString_closure" - "-Wl,-u,_base_GHCziWeak_runFinalizzerBatch_closure" + "-Wl,-u,_base_GHCziWeakziFinalizze_runFinalizzerBatch_closure" "-Wl,-u,_base_GHCziIOziException_stackOverflow_closure" "-Wl,-u,_base_GHCziIOziException_heapOverflow_closure" "-Wl,-u,_base_GHCziIOziException_allocationLimitExceeded_closure" @@ -340,7 +340,7 @@ library "-Wl,-u,ghczmprim_GHCziTypes_True_closure" "-Wl,-u,ghczmprim_GHCziTypes_False_closure" "-Wl,-u,base_GHCziPack_unpackCString_closure" - "-Wl,-u,base_GHCziWeak_runFinalizzerBatch_closure" + "-Wl,-u,base_GHCziWeakziFinalizze_runFinalizzerBatch_closure" "-Wl,-u,base_GHCziIOziException_stackOverflow_closure" "-Wl,-u,base_GHCziIOziException_heapOverflow_closure" "-Wl,-u,base_GHCziIOziException_allocationLimitExceeded_closure" diff --git a/rts/win32/libHSbase.def b/rts/win32/libHSbase.def index cb9c32729e..e91d11a688 100644 --- a/rts/win32/libHSbase.def +++ b/rts/win32/libHSbase.def @@ -34,7 +34,7 @@ EXPORTS base_GHCziTopHandler_flushStdHandles_closure - base_GHCziWeak_runFinalizzerBatch_closure + base_GHCziWeakziFinalizze_runFinalizzerBatch_closure base_GHCziPack_unpackCString_closure base_GHCziIOziException_blockedIndefinitelyOnMVar_closure base_GHCziIOziException_blockedIndefinitelyOnSTM_closure |