From 8af791d769703fd00c3a90a1fb6fac700be7988c Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Tue, 24 Sep 2019 16:59:37 -0400
Subject: [PATCH] Test: Use more robust directory removal method.

I just had a test that crashed at cleanup on linux with:

.t/gpgtest/12/S.gpg-agent.browser: removeDirectoryRecursive:removeContentsRecursive:removePathRecursive:removeContentsRecursive:removePathRecursive:removeContentsRecursive:removePathRecursive:getSymbolicLinkStatus: does not exist (No such file or directory)
sleeping 10 seconds and will retry directory cleanup
git-annex: .t/gpgtest/14/S.gpg-agent.browser: removeDirectoryRecursive:removeContentsRecursive:removePathRecursive:removeContentsRecursive:removePathRecursive:removeContentsRecursive:removePathRecursive:getSymbolicLinkStatus: does not exist (No such file or directory)

removePathForcibly is supposed to be more robust to things in the directory vanishing while it's running, etc.
Will probably avoid such crashes.

It was added to directory-1.2.7, which comes with ghc since 8.0.2.
Since base >= 4.11.1.0 means ghc 8.4.4, I expect all builds will have it,
but I ifdefed it to be sure.
---
 CHANGELOG         |  1 +
 Test/Framework.hs | 17 +++++++++++++----
 2 files changed, 14 insertions(+), 4 deletions(-)

diff --git a/CHANGELOG b/CHANGELOG
index 6fe8b7f961..67043983aa 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -4,6 +4,7 @@ git-annex (7.20190913) UNRELEASED; urgency=medium
   * Added --unlocked and --locked file matching options.
   * git-lfs: Added support for http basic auth.
   * git-lfs: Only do endpoint discovery once when concurrency is enabled.
+  * Test: Use more robust directory removal when built with directory-1.2.7.
 
  -- Joey Hess <id@joeyh.name>  Thu, 19 Sep 2019 11:11:19 -0400
 
diff --git a/Test/Framework.hs b/Test/Framework.hs
index 000d80e528..8ffcb02cdf 100644
--- a/Test/Framework.hs
+++ b/Test/Framework.hs
@@ -5,6 +5,8 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
+{-# LANGUAGE CPP #-}
+
 module Test.Framework where
 
 import Test.Tasty
@@ -223,26 +225,33 @@ isolateGitConfig a = Utility.Tmp.Dir.withTmpDir "testhome" $ \tmphome -> do
 	Utility.Env.Set.setEnv "GIT_CONFIG_NOSYSTEM" "1" True
 	a
 
+removeDirectoryForCleanup :: FilePath -> IO ()
+#ifdef MIN_VERSION_directory(1,2,7)
+removeDirectoryForCleanup = removePathForcibly
+#else
+removeDirectoryForCleanup = removeDirectoryRecursive
+#endif
+
 cleanup :: FilePath -> IO ()
 cleanup dir = whenM (doesDirectoryExist dir) $ do
 	Command.Uninit.prepareRemoveAnnexDir' dir
 	-- This can fail if files in the directory are still open by a
 	-- subprocess.
-	void $ tryIO $ removeDirectoryRecursive dir
+	void $ tryIO $ removeDirectoryForCleanup dir
 
 finalCleanup :: IO ()
 finalCleanup = whenM (doesDirectoryExist tmpdir) $ do
 	Annex.Action.reapZombies
 	Command.Uninit.prepareRemoveAnnexDir' tmpdir
-	catchIO (removeDirectoryRecursive tmpdir) $ \e -> do
+	catchIO (removeDirectoryForCleanup tmpdir) $ \e -> do
 		print e
 		putStrLn "sleeping 10 seconds and will retry directory cleanup"
 		Utility.ThreadScheduler.threadDelaySeconds $
 			Utility.ThreadScheduler.Seconds 10
 		whenM (doesDirectoryExist tmpdir) $ do
 			Annex.Action.reapZombies
-			removeDirectoryRecursive tmpdir
-	
+			removeDirectoryForCleanup tmpdir
+
 checklink :: FilePath -> Assertion
 checklink f = ifM (annexeval Config.crippledFileSystem)
 	( (isJust <$> annexeval (Annex.Link.getAnnexLinkTarget f))