Fix test suite failure when git-annex test is not run inside a git repository

Not the first time this kind of test suite breakage has happened..
It would be good to avoid somehow it looking up from .t and finding a git
repo. But just running the test suite from time to time outside of
git-annex would also let me notice these before the distribution packagers
do.

This commit was sponsored by mo on Patreon.
This commit is contained in:
Joey Hess 2018-11-05 13:27:16 -04:00
parent 5f213d45b1
commit 76a25fdcf0
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
3 changed files with 31 additions and 25 deletions

View file

@ -1,5 +1,7 @@
git-annex (7.20181032) UNRELEASED; urgency=medium
* Fix test suite failure when git-annex test is not run inside a git
repository.
* Increase minimum QuickCheck version.
* Fix a P2P protocol hang.
* importfeed: Avoid erroring out when a feed has been repeatedly broken,

40
Test.hs
View file

@ -60,7 +60,6 @@ import qualified Annex.WorkTree
import qualified Annex.Init
import qualified Annex.CatFile
import qualified Annex.Path
import qualified Annex.AdjustedBranch
import qualified Annex.VectorClock
import qualified Annex.View
import qualified Annex.View.ViewedFile
@ -1100,9 +1099,9 @@ test_conflict_resolution =
{- Conflict resolution while in an adjusted branch. -}
test_conflict_resolution_adjusted_branch :: Assertion
test_conflict_resolution_adjusted_branch = whenM (annexeval Annex.AdjustedBranch.isSupported) $
test_conflict_resolution_adjusted_branch =
withtmpclonerepo $ \r1 ->
withtmpclonerepo $ \r2 -> do
withtmpclonerepo $ \r2 -> whenM (adjustedbranchsupported r2) $ do
indir r1 $ do
disconnectOrigin
writecontent conflictor "conflictor1"
@ -1449,9 +1448,9 @@ test_mixed_lock_conflict_resolution =
- where the same file is added to both independently. The bad merge
- emptied the whole tree. -}
test_adjusted_branch_merge_regression :: Assertion
test_adjusted_branch_merge_regression = whenM (annexeval Annex.AdjustedBranch.isSupported) $
test_adjusted_branch_merge_regression = do
withtmpclonerepo $ \r1 ->
withtmpclonerepo $ \r2 -> do
withtmpclonerepo $ \r2 -> whenM (adjustedbranchsupported r1) $ do
pair r1 r2
setup r1
setup r2
@ -1476,22 +1475,21 @@ test_adjusted_branch_merge_regression = whenM (annexeval Annex.AdjustedBranch.is
- a subtree to an existing tree lost files. -}
test_adjusted_branch_subtree_regression :: Assertion
test_adjusted_branch_subtree_regression =
whenM (annexeval Annex.AdjustedBranch.isSupported) $
withtmpclonerepo $ \r -> do
indir r $ do
disconnectOrigin
git_annex "upgrade" [] @? "upgrade failed"
git_annex "adjust" ["--unlock", "--force"] @? "adjust failed"
createDirectoryIfMissing True "a/b/c"
writecontent "a/b/c/d" "foo"
git_annex "add" ["a/b/c"] @? "add a/b/c failed"
git_annex "sync" [] @? "sync failed"
createDirectoryIfMissing True "a/b/x"
writecontent "a/b/x/y" "foo"
git_annex "add" ["a/b/x"] @? "add a/b/x failed"
git_annex "sync" [] @? "sync failed"
boolSystem "git" [Param "checkout", Param "master"] @? "git checkout master failed"
doesFileExist "a/b/x/y" @? ("a/b/x/y missing from master after adjusted branch sync")
withtmpclonerepo $ \r -> whenM (adjustedbranchsupported r) $ do
indir r $ do
disconnectOrigin
git_annex "upgrade" [] @? "upgrade failed"
git_annex "adjust" ["--unlock", "--force"] @? "adjust failed"
createDirectoryIfMissing True "a/b/c"
writecontent "a/b/c/d" "foo"
git_annex "add" ["a/b/c"] @? "add a/b/c failed"
git_annex "sync" [] @? "sync failed"
createDirectoryIfMissing True "a/b/x"
writecontent "a/b/x/y" "foo"
git_annex "add" ["a/b/x"] @? "add a/b/x failed"
git_annex "sync" [] @? "sync failed"
boolSystem "git" [Param "checkout", Param "master"] @? "git checkout master failed"
doesFileExist "a/b/x/y" @? ("a/b/x/y missing from master after adjusted branch sync")
{- Set up repos as remotes of each other. -}
pair :: FilePath -> FilePath -> Assertion

View file

@ -35,6 +35,7 @@ import qualified Annex.Link
import qualified Annex.Init
import qualified Annex.Path
import qualified Annex.Action
import qualified Annex.AdjustedBranch
import qualified Utility.Process
import qualified Utility.Env
import qualified Utility.Env.Set
@ -160,18 +161,23 @@ disconnectOrigin = boolSystem "git" [Param "remote", Param "rm", Param "origin"]
withgitrepo :: (FilePath -> Assertion) -> Assertion
withgitrepo = bracket (setuprepo mainrepodir) return
indir :: FilePath -> Assertion -> Assertion
indir :: FilePath -> IO a -> IO a
indir dir a = do
currdir <- getCurrentDirectory
-- Assertion failures throw non-IO errors; catch
-- any type of error and change back to currdir before
-- rethrowing.
r <- bracket_ (changeToTmpDir dir) (setCurrentDirectory currdir)
(try a::IO (Either SomeException ()))
r <- bracket_
(changeToTmpDir dir)
(setCurrentDirectory currdir)
(tryNonAsync a)
case r of
Right () -> return ()
Right v -> return v
Left e -> throwM e
adjustedbranchsupported :: FilePath -> IO Bool
adjustedbranchsupported repo = indir repo $ annexeval Annex.AdjustedBranch.isSupported
setuprepo :: FilePath -> IO FilePath
setuprepo dir = do
cleanup dir