mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

add another test and improve error handling

Browse source
This commit is contained in:
Joey Hess 2011-01-08 15:00:04 -04:00
parent d31e61a90d
commit 82fe151f87
1 changed files with 24 additions and 14 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

26
test.hs
View file

@ -84,7 +84,13 @@ test_add = "git-annex add" ~: TestCase $ inmainrepo $ do
unannexed ingitfile unannexed ingitfile
test_unannex :: Test test_unannex :: Test
test_unannex = "git-annex unannex" ~: TestCase $ intmpcopyrepo $ do test_unannex = "git-annex unannex" ~: TestList [nocopy, withcopy]
where
nocopy = "no content" ~: intmpclonerepo $ do
r <- git_annex "unannex" ["-q", annexedfile]
not r @? "unannex incorrectly succeeded with no copy"
unannexed annexedfile
withcopy = "with content" ~: intmpcopyrepo $ do
git_annex "unannex" ["-q", annexedfile] @? "unannex failed" git_annex "unannex" ["-q", annexedfile] @? "unannex failed"
unannexed annexedfile unannexed annexedfile
git_annex "unannex" ["-q", annexedfile] @? "unannex failed on non-annexed file" git_annex "unannex" ["-q", annexedfile] @? "unannex failed on non-annexed file"
@ -93,9 +99,9 @@ test_unannex = "git-annex unannex" ~: TestCase $ intmpcopyrepo $ do
unannexed ingitfile unannexed ingitfile
test_drop :: Test test_drop :: Test
test_drop = "git-annex drop" ~: TestList [nocopy, withcopy] test_drop = "git-annex drop" ~: TestList [noremote, withremote]
where where
nocopy = "no remotes" ~: TestCase $ intmpcopyrepo $ do noremote = "no remotes" ~: TestCase $ intmpcopyrepo $ do
r <- git_annex "drop" ["-q", annexedfile] r <- git_annex "drop" ["-q", annexedfile]
(not r) @? "drop wrongly succeeded with no known copy of file" (not r) @? "drop wrongly succeeded with no known copy of file"
annexed_present annexedfile annexed_present annexedfile
@ -104,7 +110,7 @@ test_drop = "git-annex drop" ~: TestList [nocopy, withcopy]
git_annex "drop" ["-q", annexedfile] @? "drop of dropped file failed" git_annex "drop" ["-q", annexedfile] @? "drop of dropped file failed"
git_annex "drop" ["-q", ingitfile] @? "drop ingitfile should be no-op" git_annex "drop" ["-q", ingitfile] @? "drop ingitfile should be no-op"
unannexed ingitfile unannexed ingitfile
withcopy = "with remote" ~: TestCase $ intmpclonerepo $ do withremote = "with remote" ~: TestCase $ intmpclonerepo $ do
git_annex "drop" ["-q", annexedfile] @? "drop failed though origin has copy" git_annex "drop" ["-q", annexedfile] @? "drop failed though origin has copy"
annexed_notpresent annexedfile annexed_notpresent annexedfile
inmainrepo $ annexed_present annexedfile inmainrepo $ annexed_present annexedfile
@ -266,9 +272,15 @@ withgitrepo = bracket (setuprepo mainrepodir) return
indir :: FilePath -> Assertion -> Assertion indir :: FilePath -> Assertion -> Assertion
indir dir a = do indir dir a = do
cwd <- getCurrentDirectory cwd <- getCurrentDirectory
bracket_ (changeToTmpDir dir) -- Assertion failures throw non-IO errors; catch
-- any type of error and change back to cwd before
-- rethrowing.
r <- bracket_ (changeToTmpDir dir)
(\_ -> changeWorkingDirectory cwd) (\_ -> changeWorkingDirectory cwd)
a (E.try (a)::IO (Either E.SomeException ()))
case r of
Right () -> return ()
Left e -> error $ show e
setuprepo :: FilePath -> IO FilePath setuprepo :: FilePath -> IO FilePath
setuprepo dir = do setuprepo dir = do
@ -279,8 +291,6 @@ setuprepo dir = do
copyrepo :: FilePath -> FilePath -> IO FilePath copyrepo :: FilePath -> FilePath -> IO FilePath
copyrepo old new = do copyrepo old new = do
_ <- clonerepo old new
indir new $ Utility.boolSystem "git" ["remote", "rm", "origin"] @? "git remote failed"
cleanup new cleanup new
ensuretmpdir ensuretmpdir
Utility.boolSystem "cp" ["-pr", old, new] @? "cp -pr failed" Utility.boolSystem "cp" ["-pr", old, new] @? "cp -pr failed"