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 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. * Increase minimum QuickCheck version.
* Fix a P2P protocol hang. * Fix a P2P protocol hang.
* importfeed: Avoid erroring out when a feed has been repeatedly broken, * importfeed: Avoid erroring out when a feed has been repeatedly broken,

12
Test.hs
View file

@ -60,7 +60,6 @@ import qualified Annex.WorkTree
import qualified Annex.Init import qualified Annex.Init
import qualified Annex.CatFile import qualified Annex.CatFile
import qualified Annex.Path import qualified Annex.Path
import qualified Annex.AdjustedBranch
import qualified Annex.VectorClock import qualified Annex.VectorClock
import qualified Annex.View import qualified Annex.View
import qualified Annex.View.ViewedFile import qualified Annex.View.ViewedFile
@ -1100,9 +1099,9 @@ test_conflict_resolution =
{- Conflict resolution while in an adjusted branch. -} {- Conflict resolution while in an adjusted branch. -}
test_conflict_resolution_adjusted_branch :: Assertion test_conflict_resolution_adjusted_branch :: Assertion
test_conflict_resolution_adjusted_branch = whenM (annexeval Annex.AdjustedBranch.isSupported) $ test_conflict_resolution_adjusted_branch =
withtmpclonerepo $ \r1 -> withtmpclonerepo $ \r1 ->
withtmpclonerepo $ \r2 -> do withtmpclonerepo $ \r2 -> whenM (adjustedbranchsupported r2) $ do
indir r1 $ do indir r1 $ do
disconnectOrigin disconnectOrigin
writecontent conflictor "conflictor1" writecontent conflictor "conflictor1"
@ -1449,9 +1448,9 @@ test_mixed_lock_conflict_resolution =
- where the same file is added to both independently. The bad merge - where the same file is added to both independently. The bad merge
- emptied the whole tree. -} - emptied the whole tree. -}
test_adjusted_branch_merge_regression :: Assertion 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 $ \r1 ->
withtmpclonerepo $ \r2 -> do withtmpclonerepo $ \r2 -> whenM (adjustedbranchsupported r1) $ do
pair r1 r2 pair r1 r2
setup r1 setup r1
setup r2 setup r2
@ -1476,8 +1475,7 @@ test_adjusted_branch_merge_regression = whenM (annexeval Annex.AdjustedBranch.is
- a subtree to an existing tree lost files. -} - a subtree to an existing tree lost files. -}
test_adjusted_branch_subtree_regression :: Assertion test_adjusted_branch_subtree_regression :: Assertion
test_adjusted_branch_subtree_regression = test_adjusted_branch_subtree_regression =
whenM (annexeval Annex.AdjustedBranch.isSupported) $ withtmpclonerepo $ \r -> whenM (adjustedbranchsupported r) $ do
withtmpclonerepo $ \r -> do
indir r $ do indir r $ do
disconnectOrigin disconnectOrigin
git_annex "upgrade" [] @? "upgrade failed" git_annex "upgrade" [] @? "upgrade failed"

View file

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