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.
This commit is contained in:
Joey Hess 2019-09-24 16:59:37 -04:00
parent 789721b65f
commit 8af791d769
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
2 changed files with 14 additions and 4 deletions

View file

@ -4,6 +4,7 @@ git-annex (7.20190913) UNRELEASED; urgency=medium
* Added --unlocked and --locked file matching options. * Added --unlocked and --locked file matching options.
* git-lfs: Added support for http basic auth. * git-lfs: Added support for http basic auth.
* git-lfs: Only do endpoint discovery once when concurrency is enabled. * 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 -- Joey Hess <id@joeyh.name> Thu, 19 Sep 2019 11:11:19 -0400

View file

@ -5,6 +5,8 @@
- Licensed under the GNU AGPL version 3 or higher. - Licensed under the GNU AGPL version 3 or higher.
-} -}
{-# LANGUAGE CPP #-}
module Test.Framework where module Test.Framework where
import Test.Tasty import Test.Tasty
@ -223,25 +225,32 @@ isolateGitConfig a = Utility.Tmp.Dir.withTmpDir "testhome" $ \tmphome -> do
Utility.Env.Set.setEnv "GIT_CONFIG_NOSYSTEM" "1" True Utility.Env.Set.setEnv "GIT_CONFIG_NOSYSTEM" "1" True
a a
removeDirectoryForCleanup :: FilePath -> IO ()
#ifdef MIN_VERSION_directory(1,2,7)
removeDirectoryForCleanup = removePathForcibly
#else
removeDirectoryForCleanup = removeDirectoryRecursive
#endif
cleanup :: FilePath -> IO () cleanup :: FilePath -> IO ()
cleanup dir = whenM (doesDirectoryExist dir) $ do cleanup dir = whenM (doesDirectoryExist dir) $ do
Command.Uninit.prepareRemoveAnnexDir' dir Command.Uninit.prepareRemoveAnnexDir' dir
-- This can fail if files in the directory are still open by a -- This can fail if files in the directory are still open by a
-- subprocess. -- subprocess.
void $ tryIO $ removeDirectoryRecursive dir void $ tryIO $ removeDirectoryForCleanup dir
finalCleanup :: IO () finalCleanup :: IO ()
finalCleanup = whenM (doesDirectoryExist tmpdir) $ do finalCleanup = whenM (doesDirectoryExist tmpdir) $ do
Annex.Action.reapZombies Annex.Action.reapZombies
Command.Uninit.prepareRemoveAnnexDir' tmpdir Command.Uninit.prepareRemoveAnnexDir' tmpdir
catchIO (removeDirectoryRecursive tmpdir) $ \e -> do catchIO (removeDirectoryForCleanup tmpdir) $ \e -> do
print e print e
putStrLn "sleeping 10 seconds and will retry directory cleanup" putStrLn "sleeping 10 seconds and will retry directory cleanup"
Utility.ThreadScheduler.threadDelaySeconds $ Utility.ThreadScheduler.threadDelaySeconds $
Utility.ThreadScheduler.Seconds 10 Utility.ThreadScheduler.Seconds 10
whenM (doesDirectoryExist tmpdir) $ do whenM (doesDirectoryExist tmpdir) $ do
Annex.Action.reapZombies Annex.Action.reapZombies
removeDirectoryRecursive tmpdir removeDirectoryForCleanup tmpdir
checklink :: FilePath -> Assertion checklink :: FilePath -> Assertion
checklink f = ifM (annexeval Config.crippledFileSystem) checklink f = ifM (annexeval Config.crippledFileSystem)