HsSVN 0.4.2 → 0.4.3

raw patch · 3 files changed

+36/−20 lines, 3 files

Files

• HsSVN.cabal +1/−1
• NEWS +7/−0
• Subversion/Hash.hsc +28/−19

@@ -4,7 +4,7 @@     HsSVN is a (part of) Subversion binding for Haskell. Currently it     can do most things related to the Subversion FS but others are     left uncovered.-Version:       0.4.2+Version:       0.4.3 License:       PublicDomain License-File:  COPYING Author:        PHO <pho at cielonegro dot org>

@@ -1,3 +1,10 @@+Changes from 0.4.2 to 0.4.3+---------------------------+* Fixed a serious bug which leads to segmentation fault at+  apr_hash_next. The hidden module Subversion.Hash was handling APR+  memory pools wrongly.++ Changes from 0.4.1 to 0.4.2 --------------------------- * Fixed breakage on GHC 6.12.1.

@@ -88,7 +88,10 @@ foreign import ccall unsafe "apr_hash_next"         _next :: Ptr APR_HASH_INDEX_T -> IO (Ptr APR_HASH_INDEX_T) +foreign import ccall unsafe "apr_hash_pool_get"+        _pool :: Ptr APR_HASH_T -> IO (Ptr APR_POOL_T) + wrapHash :: IO () -> Ptr APR_HASH_T -> IO (Hash a) wrapHash finalizer hashPtr     = do hash <- newForeignPtr_ hashPtr@@ -169,14 +172,16 @@  getFirst :: Hash a -> IO (Maybe (HashIndex a)) getFirst hash-    = do pool <- newPool-         withPoolPtr pool $ \ poolPtr ->-             withHashPtr hash $ \ hashPtr ->-             do idxPtr <- _first poolPtr hashPtr-                if idxPtr == nullPtr then-                    return Nothing-                  else-                    liftM Just $ wrapHashIdx (touchPool pool) idxPtr+    = withHashPtr hash $ \ hashPtr ->+      do poolPtr <- _pool hashPtr+         -- The resulting idx must keep the hashtable itself alive+         -- during its lifetime. We must reuse the hashtable's memory+         -- pool.+         idxPtr  <- _first poolPtr hashPtr+         if idxPtr == nullPtr then+             return Nothing+           else+             liftM Just $ wrapHashIdx (touchHash hash) idxPtr   getThis :: HashValue a => HashIndex a -> IO (String, a)@@ -200,14 +205,10 @@          return (key, castPtr valPtr)  -getNext :: HashIndex a -> IO (Maybe (HashIndex a))-getNext idx+next :: HashIndex a -> IO Bool+next idx     = withHashIdxPtr idx $ \ idxPtr ->-      do idxPtr' <- _next idxPtr-         if idxPtr' == nullPtr then-             return Nothing-           else-             liftM Just $ wrapHashIdx (touchHashIdx idx) idxPtr'+      fmap (/= nullPtr) (_next idxPtr)                       pairsToHash :: HashValue a => [(String, a)] -> IO (Hash a)@@ -230,8 +231,12 @@     where       loop Nothing    = return []       loop (Just idx) = do x  <- f =<< getThis idx-                           xs <- unsafeInterleaveIO-                                 (getNext idx >>= loop)+                           xs <- unsafeInterleaveIO $+                                 do hasNext <- next idx+                                    if hasNext then+                                        loop (Just idx)+                                      else+                                        return []                            return (x:xs)  @@ -240,6 +245,10 @@     where       loop Nothing    = return []       loop (Just idx) = do x  <- f =<< getThis' idx-                           xs <- unsafeInterleaveIO-                                 (getNext idx >>= loop)+                           xs <- unsafeInterleaveIO $+                                 do hasNext <- next idx+                                    if hasNext then+                                        loop (Just idx)+                                      else+                                        return []                            return (x:xs)