test git-remote-annex
The added test case catches the reversion fixed in 700be6c38f
This commit is contained in:
parent
700be6c38f
commit
79cf5b1a23
2 changed files with 95 additions and 72 deletions
|
@ -140,12 +140,12 @@ annexeval a = do
|
|||
a `finally` Annex.Action.stopCoProcesses
|
||||
|
||||
innewrepo :: IO () -> IO ()
|
||||
innewrepo a = withgitrepo $ \r -> indir r a
|
||||
innewrepo a = withgitrepo $ \r -> intopdir r a
|
||||
|
||||
inmainrepo :: IO a -> IO a
|
||||
inmainrepo a = do
|
||||
d <- mainrepodir
|
||||
indir d a
|
||||
intopdir d a
|
||||
|
||||
with_ssh_origin :: (Assertion -> Assertion) -> (Assertion -> Assertion)
|
||||
with_ssh_origin cloner a = cloner $ do
|
||||
|
@ -160,7 +160,7 @@ with_ssh_origin cloner a = cloner $ do
|
|||
config = "remote.origin.url"
|
||||
|
||||
intmpclonerepo :: Assertion -> Assertion
|
||||
intmpclonerepo a = withtmpclonerepo $ \r -> indir r a
|
||||
intmpclonerepo a = withtmpclonerepo $ \r -> intopdir r a
|
||||
|
||||
checkRepo :: Types.Annex a -> FilePath -> IO a
|
||||
checkRepo getval d = do
|
||||
|
@ -170,11 +170,11 @@ checkRepo getval d = do
|
|||
|
||||
intmpbareclonerepo :: Assertion -> Assertion
|
||||
intmpbareclonerepo a = withtmpclonerepo' (newCloneRepoConfig { bareClone = True } ) $
|
||||
\r -> indir r a
|
||||
\r -> intopdir r a
|
||||
|
||||
intmpsharedclonerepo :: Assertion -> Assertion
|
||||
intmpsharedclonerepo a = withtmpclonerepo' (newCloneRepoConfig { sharedClone = True } ) $
|
||||
\r -> indir r a
|
||||
\r -> intopdir r a
|
||||
|
||||
withtmpclonerepo :: (FilePath -> Assertion) -> Assertion
|
||||
withtmpclonerepo = withtmpclonerepo' newCloneRepoConfig
|
||||
|
@ -200,14 +200,19 @@ withgitrepo a = do
|
|||
maindir <- mainrepodir
|
||||
bracket (setuprepo maindir) return a
|
||||
|
||||
indir :: FilePath -> IO a -> IO a
|
||||
indir dir a = do
|
||||
intopdir :: FilePath -> IO a -> IO a
|
||||
intopdir dir a = do
|
||||
topdir <- Utility.Env.getEnvDefault "TOPDIR" (error "TOPDIR not set")
|
||||
inpath (topdir ++ "/" ++ dir) a
|
||||
|
||||
inpath :: FilePath -> IO a -> IO a
|
||||
inpath path a = do
|
||||
currdir <- getCurrentDirectory
|
||||
-- Assertion failures throw non-IO errors; catch
|
||||
-- any type of error and change back to currdir before
|
||||
-- rethrowing.
|
||||
r <- bracket_
|
||||
(changeToTopDir dir)
|
||||
(setCurrentDirectory path)
|
||||
(setCurrentDirectory currdir)
|
||||
(tryNonAsync a)
|
||||
case r of
|
||||
|
@ -215,7 +220,7 @@ indir dir a = do
|
|||
Left e -> throwM e
|
||||
|
||||
adjustedbranchsupported :: FilePath -> IO Bool
|
||||
adjustedbranchsupported repo = indir repo $ Annex.AdjustedBranch.isGitVersionSupported
|
||||
adjustedbranchsupported repo = intopdir repo $ Annex.AdjustedBranch.isGitVersionSupported
|
||||
|
||||
setuprepo :: FilePath -> IO FilePath
|
||||
setuprepo dir = do
|
||||
|
@ -248,7 +253,7 @@ clonerepo old new cfg = do
|
|||
]
|
||||
git "clone" cloneparams "git clone"
|
||||
configrepo new
|
||||
indir new $ do
|
||||
intopdir new $ do
|
||||
ver <- annexVersion <$> getTestMode
|
||||
git_annex "init"
|
||||
[ "-q"
|
||||
|
@ -257,12 +262,12 @@ clonerepo old new cfg = do
|
|||
]
|
||||
"git annex init"
|
||||
unless (bareClone cfg) $
|
||||
indir new $
|
||||
intopdir new $
|
||||
setupTestMode
|
||||
return new
|
||||
|
||||
configrepo :: FilePath -> IO ()
|
||||
configrepo dir = indir dir $ do
|
||||
configrepo dir = intopdir dir $ do
|
||||
-- ensure git is set up to let commits happen
|
||||
git "config" ["user.name", "Test User"]
|
||||
"git config"
|
||||
|
@ -556,11 +561,6 @@ setupTestMode = do
|
|||
git "commit" ["--allow-empty", "-m", "empty"] "git commit failed"
|
||||
git_annex "adjust" ["--unlock"] "git annex adjust failed"
|
||||
|
||||
changeToTopDir :: FilePath -> IO ()
|
||||
changeToTopDir t = do
|
||||
topdir <- Utility.Env.getEnvDefault "TOPDIR" (error "TOPDIR not set")
|
||||
setCurrentDirectory $ topdir ++ "/" ++ t
|
||||
|
||||
tmpdir :: String
|
||||
tmpdir = ".t"
|
||||
|
||||
|
@ -687,7 +687,7 @@ origBranch = maybe "foo"
|
|||
|
||||
{- Set up repos as remotes of each other. -}
|
||||
pair :: FilePath -> FilePath -> Assertion
|
||||
pair r1 r2 = forM_ [r1, r2] $ \r -> indir r $ do
|
||||
pair r1 r2 = forM_ [r1, r2] $ \r -> intopdir r $ do
|
||||
when (r /= r1) $
|
||||
git "remote" ["add", "r1", "../" ++ r1] "remote add"
|
||||
when (r /= r2) $
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue