fix test suite

14683da9ebd629c3f77405b646d3f5661874f9d6 caused a test suite failure.
When the content of a key is not present, a LinkAnnexFailed is returned,
but replaceFile then tried to move the file into place, and since it was
not written, that crashed.

Sponsored-by: Boyd Stephen Smith Jr. on Patreon

diff --git a/Annex/Content.hs b/Annex/Content.hs
index 6e5b98467715dd0d109cfd1c31421fa9639a5bf1..4f05d61f67ac3aac6447867a03bf9fc0a35fca75 100644 (file)
--- a/Annex/Content.hs
+++ b/Annex/Content.hs
@@ -374,6 +374,7 @@ checkSecureHashes' key = checkSecureHashes key >>= \case
                return False
 
 data LinkAnnexResult = LinkAnnexOk | LinkAnnexFailed | LinkAnnexNoop
+       deriving (Eq)
 
 {- Populates the annex object file by hard linking or copying a source
  - file to it. -}
@@ -396,7 +397,7 @@ linkToAnnex key src srcic = ifM (checkSecureHashes' key)
  -}
 linkFromAnnex :: Key -> RawFilePath -> Maybe FileMode -> Annex LinkAnnexResult
 linkFromAnnex key dest destmode =
-       replaceFile (const noop) (fromRawFilePath dest) $ \tmp ->
+       replaceFile' (const noop) (fromRawFilePath dest) (== LinkAnnexOk) $ \tmp ->
                linkFromAnnex' key (toRawFilePath tmp) destmode
 
 {- This is only safe to use when dest is not a worktree file. -}

diff --git a/Annex/ReplaceFile.hs b/Annex/ReplaceFile.hs
index ffe5287c900fbd44af308721eb1b6acf75ca5569..04125fd7c3849bf76b98b30de1febe5f1e1c2b36 100644 (file)
--- a/Annex/ReplaceFile.hs
+++ b/Annex/ReplaceFile.hs
@@ -1,6 +1,6 @@
 {- git-annex file replacing
  -
- - Copyright 2013-2020 Joey Hess <id@joeyh.name>
+ - Copyright 2013-2021 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -12,6 +12,7 @@ module Annex.ReplaceFile (
        replaceGitDirFile,
        replaceWorkTreeFile,
        replaceFile,
+       replaceFile',
 ) where
 
 import Annex.Common
@@ -54,7 +55,10 @@ replaceWorkTreeFile = replaceFile createWorkTreeDirectory
  - fails, and can create any parent directory structure needed.
  -}
 replaceFile :: (RawFilePath -> Annex ()) -> FilePath -> (FilePath -> Annex a) -> Annex a
-replaceFile createdirectory file action = withOtherTmp $ \othertmpdir -> do
+replaceFile createdirectory file action = replaceFile' createdirectory file (const True) action
+
+replaceFile' :: (RawFilePath -> Annex ()) -> FilePath -> (a -> Bool) -> (FilePath -> Annex a) -> Annex a
+replaceFile' createdirectory file checkres action = withOtherTmp $ \othertmpdir -> do
        let othertmpdir' = fromRawFilePath othertmpdir
 #ifndef mingw32_HOST_OS
        -- Use part of the filename as the template for the temp
@@ -70,7 +74,8 @@ replaceFile createdirectory file action = withOtherTmp $ \othertmpdir -> do
        withTmpDirIn othertmpdir' basetmp $ \tmpdir -> do
                let tmpfile = tmpdir </> basetmp
                r <- action tmpfile
-               replaceFileFrom tmpfile file createdirectory
+               when (checkres r) $
+                       replaceFileFrom tmpfile file createdirectory
                return r
 
 replaceFileFrom :: FilePath -> FilePath -> (RawFilePath -> Annex ()) -> Annex ()