Fix a memory leak introduced in the last release

The problem was this line:

	cleanup = and <$> sequence (map snd v)

That caused all of v to be held onto until the end, when the cleanup action
was run.

I could not seem to find a bang pattern that avoided the leak, so I
resorted to a IORef, rather clunky, but not a performance problem because
it will only be written once per git ls-files, so typically just 1 time.

This commit was sponsored by Mark Reidenbach on Patreon.

diff --git a/CHANGELOG b/CHANGELOG
index 5bc58e6f36f35196eb855ee6e46bd1507d9bbf59..cdffcba3bfb4c1a88fec86b2ca384817c31ce851 100644 (file)
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -1,6 +1,7 @@
 git-annex (8.20201008) UNRELEASED; urgency=medium
 
   * Fix build on Windows with network-3.
+  * Fix a memory leak introduced in the last release.
 
  -- Joey Hess <id@joeyh.name>  Thu, 08 Oct 2020 10:48:17 -0400
 

diff --git a/CmdLine/Seek.hs b/CmdLine/Seek.hs
index 9a5f2d246e2ad2a990d384b8bcac8de13718ee8f..34a9d20465cc1041377302a3ecd023531409a289 100644 (file)
--- a/CmdLine/Seek.hs
+++ b/CmdLine/Seek.hs
@@ -48,6 +48,7 @@ import CmdLine.Action
 
 import Control.Concurrent.Async
 import System.Posix.Types
+import Data.IORef
 
 data AnnexedFileSeeker = AnnexedFileSeeker
        { startAction :: SeekInput -> RawFilePath -> Key -> CommandStart
@@ -416,18 +417,24 @@ seekFilteredKeys seeker listfs = do
 seekHelper :: (a -> RawFilePath) -> WarnUnmatchWhen -> ([LsFiles.Options] -> [RawFilePath] -> Git.Repo -> IO ([a], IO Bool)) -> WorkTreeItems -> Annex ([(SeekInput, a)], IO Bool)
 seekHelper c ww a (WorkTreeItems l) = do
        os <- seekOptions ww
-       inRepo $ \g -> combinelists <$> forM (segmentXargsOrdered l)
-               (runSegmentPaths' mk c (\fs -> a os fs g) . map toRawFilePath)
+       v <- liftIO $ newIORef []
+       r <- inRepo $ \g -> concat . concat <$> forM (segmentXargsOrdered l)
+               (runSegmentPaths' mk c (\fs -> go v os fs g) . map toRawFilePath)
+       return (r, cleanupall v)
   where
        mk (Just i) f = (SeekInput [fromRawFilePath i], f) 
        -- This is not accurate, but it only happens when there are a
        -- great many input WorkTreeItems.
        mk Nothing f = (SeekInput [fromRawFilePath (c f)], f)
 
-       combinelists v = 
-               let r = concat $ concat $ map fst v
-                   cleanup = and <$> sequence (map snd v)
-               in (r, cleanup)
+       go v os fs g = do
+               (l, cleanup) <- a os fs g
+               liftIO $ modifyIORef' v (cleanup:)
+               return l
+
+       cleanupall v = do
+               cleanups <- readIORef v
+               and <$> sequence cleanups
 seekHelper _ _ _ NoWorkTreeItems = return ([], pure True)
 
 data WarnUnmatchWhen = WarnUnmatchLsFiles | WarnUnmatchWorkTreeItems

diff --git a/Utility/Path.hs b/Utility/Path.hs
index 570445076f1c200825aecba3a88fc00e6ff6fad2..6f38b07c13f56b85bd893d97860d0ac5183b4498 100644 (file)
--- a/Utility/Path.hs
+++ b/Utility/Path.hs
@@ -235,15 +235,11 @@ segmentPaths' f c (i:is) new =
  - than it would be to run the action separately with each path. In
  - the case of git file list commands, that assumption tends to hold.
  -}
-runSegmentPaths :: (a -> RawFilePath) -> ([RawFilePath] -> IO ([a], v)) -> [RawFilePath] -> IO ([[a]], v)
-runSegmentPaths c a paths = do
-       (l, cleanup) <- a paths
-       return (segmentPaths c paths l, cleanup)
+runSegmentPaths :: (a -> RawFilePath) -> ([RawFilePath] -> IO [a]) -> [RawFilePath] -> IO [[a]]
+runSegmentPaths c a paths = segmentPaths c paths <$> a paths
 
-runSegmentPaths' :: (Maybe RawFilePath -> a -> r) -> (a -> RawFilePath) -> ([RawFilePath] -> IO ([a], v)) -> [RawFilePath] -> IO ([[r]], v)
-runSegmentPaths' si c a paths = do
-       (l, cleanup) <- a paths
-       return (segmentPaths' si c paths l, cleanup)
+runSegmentPaths' :: (Maybe RawFilePath -> a -> r) -> (a -> RawFilePath) -> ([RawFilePath] -> IO [a]) -> [RawFilePath] -> IO [[r]]
+runSegmentPaths' si c a paths = segmentPaths' si c paths <$> a paths
 
 {- Converts paths in the home directory to use ~/ -}
 relHome :: FilePath -> IO String

diff --git a/doc/todo/memory_use_increase/comment_8_244acef6b20ac8fc281372f0898a49be._comment b/doc/todo/memory_use_increase/comment_8_244acef6b20ac8fc281372f0898a49be._comment
new file mode 100644 (file)
index 0000000..693852e
--- /dev/null
+++ b/doc/todo/memory_use_increase/comment_8_244acef6b20ac8fc281372f0898a49be._comment
@@ -0,0 +1,12 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 8"""
+ date="2020-10-13T19:52:50Z"
+ content="""
+[[!commit f624876dc21fed141eee368c86f4b209852ab91c]] is where seekHelper
+went bad. Fixed that.
+
+git-annex is still allocating 120 mb in this situation, though the
+profile now shows a max memory use of 4 mb. Still don't understand that, so
+this remains open.
+"""]]