diff --git a/Hipmunk.cabal b/Hipmunk.cabal --- a/Hipmunk.cabal +++ b/Hipmunk.cabal @@ -3,7 +3,7 @@ Tested-With: GHC Category: Physics, Game Name: Hipmunk -Version: 5.2.0.5 +Version: 5.2.0.6 Stability: provisional License: OtherLicense License-File: LICENSE @@ -20,10 +20,14 @@ Please see for a demonstration of this library. . + New in version 5.2.0.6: + . + * Fixed a memory leak related to collision handlers. + . New in version 5.2.0.5: . * Always compile @wrapper.c@ and fix Haddock errors - while handling Unicode. Thanks, Joachim Breitner. + while handling Unicode. Thanks, Joachim Breitner. . New in version 5.2.0.4: . diff --git a/NEWS b/NEWS --- a/NEWS +++ b/NEWS @@ -1,3 +1,7 @@ +Version 5.2.0.6 +=============== + - Fixed a memory leak related to collision handlers. + Version 5.2.0.5 =============== - Always compile @wrapper.c@ and fix Haddock errors diff --git a/Physics/Hipmunk/Callbacks.hsc b/Physics/Hipmunk/Callbacks.hsc --- a/Physics/Hipmunk/Callbacks.hsc +++ b/Physics/Hipmunk/Callbacks.hsc @@ -498,15 +498,15 @@ let handlerAdder p = cpSpaceAddCollisionHandler p cta ctb ptrs <- addHandler spce handlerAdder handler - -- Free the previous one and record the new one, using - -- updateLookupWithKey :: Ord k => (k -> a -> Maybe a) -> k - -- -> Map k a -> (Maybe a, Map k a) + -- Free the previous one and record the new one. cbs <- readIORef callbacks let handlers = cbsHandlers cbs - val = case handler of - Handler Nothing Nothing Nothing Nothing -> Nothing - _ -> Just ptrs - (old,handlers') = M.updateLookupWithKey (\_ _ -> val) (cta,ctb) handlers + old = M.lookup (cta,ctb) handlers + handlers' = + if ptrs == (nullFunPtr, nullFunPtr, nullFunPtr, nullFunPtr) + -- no need to gc nullFunPtrs + then handlers + else M.insert (cta,ctb) ptrs handlers maybe (return ()) freeHandlerFunPtrs old writeIORef callbacks $ cbs {cbsHandlers = handlers'}