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

@ -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