git.iko.soy/reflex
on develop help sign in
Fix an issue where roots fail to clean themselves up if they die in the same moment as all of their children
commit399906d1b4c47437bcb1b106e49ed68170f85e79 authorRyan Trinkle <ryan.trinkle@gmail.com> dateMon 20 Feb 2017, 03:36 (10 years ago) parentdb2fcb1
5 files changed+48−2
compare with develop
unifiedsplit
reflex.cabal+7 src/Data/WeakBag.hs+3 src/Reflex/Spider/Internal.hs+12−2 test/hlint.hs+1 test/rootCleanup.hs+25
reflex.cabal+7
@@ -183,6 +183,13 @@ test-suite GC-Semantics
183183 , reflex
184184 , ref-tf
185185
186+test-suite rootCleanup
187+ type: exitcode-stdio-1.0
188+ main-is: rootCleanup.hs
189+ hs-source-dirs: test
190+ build-depends: base
191+ , reflex
192+
186193benchmark spider-bench
187194 type: exitcode-stdio-1.0
188195 hs-source-dirs: bench
src/Data/WeakBag.hs+3
@@ -16,6 +16,9 @@ module Data.WeakBag
1616 , insert
1717 , traverse
1818 , remove
19+ -- * Internal functions
20+ -- These will not always be available.
21+ , _weakBag_children --TODO: Don't export this
1922 ) where
2023
2124import Control.Exception
src/Reflex/Spider/Internal.hs+12−2
@@ -73,7 +73,7 @@ import Data.Monoid (mempty)
7373import Data.Tree (Forest, Tree (..), drawForest)
7474#endif
7575
76−import Data.WeakBag (WeakBag, WeakBagTicket)
76+import Data.WeakBag (WeakBag, WeakBagTicket, _weakBag_children)
7777import qualified Data.WeakBag as WeakBag
7878#ifndef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL
7979import Data.Reflection
@@ -1365,7 +1365,17 @@ getRootSubscribed k r sub = do
13651365 , rootSubscribedNodeId = unsafeNodeId (k, r, subs)
13661366#endif
13671367 }
1368− writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug subscribed "RootSubscribed"
1368+ -- If we die at the same moment that all our children die, they will
1369+ -- try to clean us up but will fail because their Weak reference to us
1370+ -- will also be dead. So, if we are dying, check if there are any
1371+ -- children; since children don't bother cleaning themselves up if
1372+ -- their parents are already dead, I don't think there's a race
1373+ -- condition here. However, if there are any children, then we can
1374+ -- infer that we need to clean ourselves up, so we do.
1375+ finalCleanup = do
1376+ cs <- readIORef $ _weakBag_children subs
1377+ when (not $ IntMap.null cs) (cleanupRootSubscribed subscribed)
1378+ writeIORef weakSelf =<< evaluate =<< mkWeakPtr subscribed (Just finalCleanup)
13691379 modifyIORef' (rootSubscribed r) $ DMap.insertWith (error $ "getRootSubscribed: duplicate key inserted into Root") k subscribed --TODO: I think we can just write back mSubscribed rather than re-reading it
13701380 occ <- getOcc
13711381 return (sln, subscribed, occ)
test/hlint.hs+1
@@ -13,6 +13,7 @@ main = do
1313 , "--ignore=Use const"
1414 , "--ignore=Use >=>"
1515 , "--ignore=Use ."
16+ , "--ignore=Use unless"
1617 , "--cpp-define=USE_TEMPLATE_HASKELL"
1718 ]
1819 if null ideas then exitSuccess else exitFailure
test/rootCleanup.hsnew file+25
@@ -0,0 +1,25 @@
1+import Control.Monad
2+import Control.Concurrent
3+import Reflex
4+import Reflex.Host.Class
5+import System.Mem
6+import Data.IORef
7+import System.Exit
8+
9+main :: IO ()
10+main = do
11+ numSubscriptions <- newIORef 0
12+ replicateM_ 1000 $ do
13+ runSpiderHost $ do
14+ e <- newEventWithTrigger $ \_ -> do
15+ modifyIORef' numSubscriptions succ
16+ return $ modifyIORef' numSubscriptions pred
17+ _ <- hold () e
18+ return ()
19+ replicateM_ 100 $ do
20+ performMajorGC
21+ threadDelay 1
22+ n <- readIORef numSubscriptions
23+ if n == 0
24+ then putStrLn "Succeeded"
25+ else putStrLn "Failed" >> exitFailure