@@ -47,8 +47,12 @@ import qualified Control.Exception
4747import Data.IORef
4848import GHC.Stack (HasCallStack , callStack )
4949import System.IO.Unsafe (unsafeDupablePerformIO , unsafePerformIO )
50- import System.Mem (performMajorGC )
5150import System.Mem.Weak hiding (deRefWeak )
51+ #if MIN_VERSION_base(4,20,0)
52+ import System.Mem (performBlockingMajorGC )
53+ #else
54+ import System.Mem (performMajorGC )
55+ #endif
5256#endif
5357
5458
@@ -468,12 +472,28 @@ checkForgottenRefs = do
468472#ifndef NO_IGNORE_ASSERTS
469473 return ()
470474#else
471- performMajorGC
475+ -- The hope is that by combining `performMajorGC` with `yield` that the
476+ -- former starts the finalizer threads for all dropped weak references and
477+ -- the latter suspends the current process and puts it at the end of the
478+ -- thread queue, such that when the current process resumes the finalizer
479+ -- threads for all dropped weak references have finished.
480+ -- Unfortunately, this relies on the implementation of the GHC scheduler,
481+ -- not on any Haskell specification, and is therefore both non-portable and
482+ -- presumably rather brittle. Therefore, for good measure, we do it twice.
483+ performMajorGCWithBlockingIfAvailable
472484 yield
473- assertNoForgottenRefs
474- -- And for good measure, we'll do it again
475- performMajorGC
485+ performMajorGCWithBlockingIfAvailable
476486 yield
477487 assertNoForgottenRefs
488+ where
478489#endif
479490
491+ #ifdef NO_IGNORE_ASSERTS
492+ performMajorGCWithBlockingIfAvailable :: IO ()
493+ performMajorGCWithBlockingIfAvailable = do
494+ #if MIN_VERSION_base(4,20,0)
495+ performBlockingMajorGC
496+ #else
497+ performMajorGC
498+ #endif
499+ #endif
0 commit comments