c3b24ca · reflex-dom · git.iko.soy

git.iko.soy/reflex-dom

Fix a memory leak; add a test that demonstrates it

commitc3b24ca437cc05dfa7f842a117a28b4aac5e04e4 authorRyan Trinkle <ryan.trinkle@gmail.com> dateFri 24 Feb 2017, 18:19 (10 years ago) parentda700a7

2 files changed+25−1

compare with develop

unifiedsplit

reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs+4−1 reflex-dom-core/test/gc.hs+21

reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs+4−1

@@ -31,6 +31,7 @@ import Reflex.TriggerEvent.Base hiding (askEvents)

3131import Reflex.TriggerEvent.Class

3232

3333import Control.Concurrent.Chan

34+import Control.Exception (evaluate)

3435import Control.Lens hiding (element, ix)

3536import Control.Monad.Exception

3637import Control.Monad.Primitive

@@ -224,6 +225,9 @@ wrap e cfg = do

224225 liftIO $ forM_ mv $ \v -> writeChan events [TriggerRef triggerRef :=> TriggerInvocation v (return ())]

225226 return $ en :=> EventFilterTriggerRef triggerRef

226227 es <- do

228+ let h :: forall en. (EventName en, GhcjsDomEvent en) -> JSM (Maybe (er en))

229+ h = _ghcjsEventSpec_handler $ _rawElementConfig_eventSpec cfg -- Note: this needs to be done strictly and outside of the newFanEventWithTrigger, so that the newFanEventWithTrigger doesn't retain the entire cfg, which can cause a cyclic dependency that the GC won't be able to clean up

230+ _ <- liftIO $ evaluate h

227231 ctx <- askJSM

228232 newFanEventWithTrigger $ \(WrapArg en) t ->

229233 case DMap.lookup en eventTriggerRefs of

@@ -233,7 +237,6 @@ wrap e cfg = do

233237 writeIORef r Nothing

234238 Nothing -> (`runJSM` ctx) <$> (`runJSM` ctx) (elementOnEventName en e $ do

235239 evt <- DOM.event

236− let h = _ghcjsEventSpec_handler $ _rawElementConfig_eventSpec cfg

237240 mv <- lift $ h (en, GhcjsDomEvent evt)

238241 case mv of

239242 Nothing -> return ()

reflex-dom-core/test/gc.hsnew file+21

@@ -0,0 +1,21 @@

1+{-# LANGUAGE OverloadedStrings #-}

2+{-# LANGUAGE RecursiveDo #-}

3+import Control.Concurrent

4+import Control.Monad

5+import Control.Monad.IO.Class

6+import Language.Javascript.JSaddle.Warp

7+import Reflex.Dom.Core

8+import Reflex.Dom.Main

10+main :: IO ()

11+main = run 3911 $ do

12+ mainWidget $ do

13+ let w = do

14+ rec let modifyAttrs = flip pushAlways (updated d) $ \_ -> sample $ current d

15+ (e, _) <- element "button" (def & modifyAttributes .~ modifyAttrs) blank

16+ d <- holdDyn mempty $ mempty <$ domEvent Click e

17+ return ()

18+ redraw <- button "Redraw"

19+ _ <- widgetHold w $ w <$ redraw

20+ return ()

21+ liftIO $ forever $ threadDelay 1000000000