From: Joey Hess <joeyh@joeyh.name>
Date: Mon, 2 Aug 2021 17:59:23 +0000 (-0400)
Subject: fix test suite
X-Git-Tag: archive/raspbian/10.20250416-2+rpi1~1^2~91^2~6
X-Git-Url: https://dgit.raspbian.org/?a=commitdiff_plain;h=6111958440353844a926b689ee3dcfe9c13a7c1c;p=git-annex.git

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 6e5b984677..4f05d61f67 100644
--- 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 ffe5287c90..04125fd7c3 100644
--- 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 ()