From e80f7f2eb03278d77de2b015e6a6a83875c08b2c Mon Sep 17 00:00:00 2001 From: Joris Dral Date: Mon, 30 Dec 2024 16:06:20 +0100 Subject: [PATCH 1/2] Regression test for references with erroring finalisers In debug mode if the finaliser of a reference counted object throws an error, then the `RefTracker` is never released. `checkForgottenRefs` will then report the reference as forgotten, even though the finaliser ran, though not successfully. The test that is added in this commit indeed shows this is the case. The next commit fixes the issue, which should improve the experience of debugging finalisers that fail. --- test-control/Test/Control/RefCount.hs | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/test-control/Test/Control/RefCount.hs b/test-control/Test/Control/RefCount.hs index b2e7e6aaf..bcb514507 100644 --- a/test-control/Test/Control/RefCount.hs +++ b/test-control/Test/Control/RefCount.hs @@ -28,6 +28,7 @@ tests = testGroup "Control.RefCount" [ , testProperty "prop_ref_never_released0" prop_ref_never_released0 , testProperty "prop_ref_never_released1" prop_ref_never_released1 , testProperty "prop_ref_never_released2" prop_ref_never_released2 + , testProperty "prop_release_ref_exception" prop_release_ref_exception #endif ] @@ -176,5 +177,13 @@ expectRefNeverReleased :: RefException -> IO Property expectRefNeverReleased RefNeverReleased{} = return (property True) expectRefNeverReleased e = return (counterexample (displayException e) $ property False) + +-- | If a finaliser throws an exception, then the 'RefTracker' is still released +prop_release_ref_exception :: Property +prop_release_ref_exception = once $ ioProperty $ do + finalised <- newIORef False + ref <- newRef (writeIORef finalised True >> error "oops") TestObject + _ <- try @SomeException (releaseRef ref) + checkForgottenRefs #endif From 2880e5eb973ce611b471bd80435a199a7318421e Mon Sep 17 00:00:00 2001 From: Joris Dral Date: Mon, 30 Dec 2024 16:10:04 +0100 Subject: [PATCH 2/2] Release a `RefTracker` even if the corresponding finaliser throws an error --- src-control/Control/RefCount.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src-control/Control/RefCount.hs b/src-control/Control/RefCount.hs index e033dc80a..8732d3a93 100644 --- a/src-control/Control/RefCount.hs +++ b/src-control/Control/RefCount.hs @@ -249,8 +249,8 @@ releaseRef :: -> m () releaseRef ref@Ref{refobj} = do assertNoDoubleRelease ref - decrementRefCounter (getRefCounter refobj) releaseRefTracker ref + decrementRefCounter (getRefCounter refobj) {-# COMPLETE DeRef #-} #if MIN_VERSION_GLASGOW_HASKELL(9,0,0,0)