Test suite improvements. Current top-level test coverage: 65%
This commit is contained in:
Joey Hess
parent
6cb1dff757
commit
f3472d3a5d
2 changed files with 185 additions and 90 deletions
2
debian/changelog
vendored
2
debian/changelog
vendored
|
|
@ -10,7 +10,7 @@ git-annex (0.16) UNRELEASED; urgency=low
|
|||
about repositories with missing UUIDs.
|
||||
* bugfix: Running `move --to` with a non-ssh remote failed.
|
||||
* bugfix: Running `copy --to` with a non-ssh remote actually did a move.
|
||||
* Test suite improvements. Current top-level test coverage: 62%
|
||||
* Test suite improvements. Current top-level test coverage: 65%
|
||||
|
||||
-- Joey Hess <joeyh@debian.org> Tue, 04 Jan 2011 17:33:42 -0400
|
||||
|
||||
|
|
|
|||
273
test.hs
273
test.hs
|
|
@ -25,7 +25,7 @@ import qualified GitAnnex
|
|||
|
||||
main :: IO ()
|
||||
main = do
|
||||
tweakpath
|
||||
prepare
|
||||
r <- runVerboseTests $ TestList [quickchecks, toplevels]
|
||||
cleanup tmpdir
|
||||
propigate r
|
||||
|
|
@ -56,10 +56,13 @@ toplevels = TestLabel "toplevel" $ TestList
|
|||
, test_get
|
||||
, test_move
|
||||
, test_copy
|
||||
, test_lock
|
||||
, test_edit
|
||||
, test_fix
|
||||
]
|
||||
|
||||
test_init :: Test
|
||||
test_init = "git-annex init" ~: innewrepo $ do
|
||||
test_init = "git-annex init" ~: TestCase $ innewrepo $ do
|
||||
git_annex "init" ["-q", reponame] @? "init failed"
|
||||
e <- doesFileExist annexlog
|
||||
e @? (annexlog ++ " not created")
|
||||
|
|
@ -70,105 +73,159 @@ test_init = "git-annex init" ~: innewrepo $ do
|
|||
reponame = "test repo"
|
||||
|
||||
test_add :: Test
|
||||
test_add = "git-annex add" ~: inoldrepo $ do
|
||||
test_add = "git-annex add" ~: TestCase $ inmainrepo $ do
|
||||
writeFile annexedfile $ content annexedfile
|
||||
git_annex "add" ["-q", annexedfile] @? "add failed"
|
||||
checklink annexedfile
|
||||
checkcontent annexedfile
|
||||
checkunwritable annexedfile
|
||||
annexed_present annexedfile
|
||||
writeFile ingitfile $ content ingitfile
|
||||
Utility.boolSystem "git" ["add", ingitfile] @? "git add failed"
|
||||
Utility.boolSystem "git" ["commit", "-q", "-a", "-m", "commit"] @? "git commit failed"
|
||||
git_annex "add" ["-q", ingitfile] @? "add ingitfile should be no-op"
|
||||
checkregularfile ingitfile
|
||||
unannexed ingitfile
|
||||
|
||||
test_unannex :: Test
|
||||
test_unannex = "git-annex unannex" ~: intmpcopyrepo $ do
|
||||
test_unannex = "git-annex unannex" ~: TestCase $ intmpcopyrepo $ do
|
||||
git_annex "unannex" ["-q", annexedfile] @? "unannex failed"
|
||||
checkregularfile annexedfile
|
||||
unannexed annexedfile
|
||||
git_annex "unannex" ["-q", annexedfile] @? "unannex failed on non-annexed file"
|
||||
checkregularfile annexedfile
|
||||
unannexed annexedfile
|
||||
git_annex "unannex" ["-q", ingitfile] @? "unannex ingitfile should be no-op"
|
||||
unannexed ingitfile
|
||||
|
||||
test_drop :: Test
|
||||
test_drop = "git-annex drop" ~: intmpcopyrepo $ do
|
||||
r <- git_annex "drop" ["-q", annexedfile]
|
||||
(not r) @? "drop wrongly succeeded with no known copy of file"
|
||||
checklink annexedfile
|
||||
checkcontent annexedfile
|
||||
git_annex "drop" ["-q", "--force", annexedfile] @? "drop --force failed"
|
||||
checklink annexedfile
|
||||
checkdangling annexedfile
|
||||
checkunwritable annexedfile
|
||||
git_annex "drop" ["-q", annexedfile] @? "drop of dropped file failed"
|
||||
git_annex "drop" ["-q", ingitfile] @? "drop ingitfile should be no-op"
|
||||
checkregularfile ingitfile
|
||||
checkcontent ingitfile
|
||||
test_drop = "git-annex drop" ~: TestList [nocopy, withcopy]
|
||||
where
|
||||
nocopy = "no remotes" ~: TestCase $ intmpcopyrepo $ do
|
||||
r <- git_annex "drop" ["-q", annexedfile]
|
||||
(not r) @? "drop wrongly succeeded with no known copy of file"
|
||||
annexed_present annexedfile
|
||||
git_annex "drop" ["-q", "--force", annexedfile] @? "drop --force failed"
|
||||
annexed_notpresent annexedfile
|
||||
git_annex "drop" ["-q", annexedfile] @? "drop of dropped file failed"
|
||||
git_annex "drop" ["-q", ingitfile] @? "drop ingitfile should be no-op"
|
||||
unannexed ingitfile
|
||||
withcopy = "with remote" ~: TestCase $ intmpclonerepo $ do
|
||||
git_annex "drop" ["-q", annexedfile] @? "drop failed though origin has copy"
|
||||
annexed_notpresent annexedfile
|
||||
inmainrepo $ annexed_present annexedfile
|
||||
|
||||
test_get :: Test
|
||||
test_get = "git-annex get" ~: intmpclonerepo $ do
|
||||
test_get = "git-annex get" ~: TestCase $ intmpclonerepo $ do
|
||||
inmainrepo $ annexed_present annexedfile
|
||||
annexed_notpresent annexedfile
|
||||
git_annex "get" ["-q", annexedfile] @? "get of file failed"
|
||||
checklink annexedfile
|
||||
checkcontent annexedfile
|
||||
checkunwritable annexedfile
|
||||
inmainrepo $ annexed_present annexedfile
|
||||
annexed_present annexedfile
|
||||
git_annex "get" ["-q", annexedfile] @? "get of file already here failed"
|
||||
checklink annexedfile
|
||||
checkcontent annexedfile
|
||||
checkunwritable annexedfile
|
||||
inmainrepo $ annexed_present annexedfile
|
||||
annexed_present annexedfile
|
||||
inmainrepo $ unannexed ingitfile
|
||||
unannexed ingitfile
|
||||
git_annex "get" ["-q", ingitfile] @? "get ingitfile should be no-op"
|
||||
checkregularfile ingitfile
|
||||
checkcontent ingitfile
|
||||
inmainrepo $ unannexed ingitfile
|
||||
unannexed ingitfile
|
||||
|
||||
test_move :: Test
|
||||
test_move = "git-annex move" ~: intmpclonerepo $ do
|
||||
test_move = "git-annex move" ~: TestCase $ intmpclonerepo $ do
|
||||
annexed_notpresent annexedfile
|
||||
inmainrepo $ annexed_present annexedfile
|
||||
git_annex "move" ["-q", "--from", "origin", annexedfile] @? "move --from of file failed"
|
||||
checklink annexedfile
|
||||
checkcontent annexedfile
|
||||
checkunwritable annexedfile
|
||||
annexed_present annexedfile
|
||||
inmainrepo $ annexed_notpresent annexedfile
|
||||
git_annex "move" ["-q", "--from", "origin", annexedfile] @? "move --from of file already here failed"
|
||||
checklink annexedfile
|
||||
checkcontent annexedfile
|
||||
checkunwritable annexedfile
|
||||
annexed_present annexedfile
|
||||
inmainrepo $ annexed_notpresent annexedfile
|
||||
git_annex "move" ["-q", "--to", "origin", annexedfile] @? "move --to of file failed"
|
||||
checklink annexedfile
|
||||
checkdangling annexedfile
|
||||
checkunwritable annexedfile
|
||||
inmainrepo $ annexed_present annexedfile
|
||||
annexed_notpresent annexedfile
|
||||
git_annex "move" ["-q", "--to", "origin", annexedfile] @? "move --to of file already there failed"
|
||||
checklink annexedfile
|
||||
checkdangling annexedfile
|
||||
checkunwritable annexedfile
|
||||
inmainrepo $ annexed_present annexedfile
|
||||
annexed_notpresent annexedfile
|
||||
unannexed ingitfile
|
||||
inmainrepo $ unannexed ingitfile
|
||||
git_annex "move" ["-q", "--to", "origin", ingitfile] @? "move of ingitfile should be no-op"
|
||||
checkregularfile ingitfile
|
||||
checkcontent ingitfile
|
||||
unannexed ingitfile
|
||||
inmainrepo $ unannexed ingitfile
|
||||
git_annex "move" ["-q", "--from", "origin", ingitfile] @? "move of ingitfile should be no-op"
|
||||
checkregularfile ingitfile
|
||||
checkcontent ingitfile
|
||||
unannexed ingitfile
|
||||
inmainrepo $ unannexed ingitfile
|
||||
|
||||
test_copy :: Test
|
||||
test_copy = "git-annex copy" ~: intmpclonerepo $ do
|
||||
test_copy = "git-annex copy" ~: TestCase $ intmpclonerepo $ do
|
||||
annexed_notpresent annexedfile
|
||||
inmainrepo $ annexed_present annexedfile
|
||||
git_annex "copy" ["-q", "--from", "origin", annexedfile] @? "copy --from of file failed"
|
||||
checklink annexedfile
|
||||
checkcontent annexedfile
|
||||
checkunwritable annexedfile
|
||||
annexed_present annexedfile
|
||||
inmainrepo $ annexed_present annexedfile
|
||||
git_annex "copy" ["-q", "--from", "origin", annexedfile] @? "copy --from of file already here failed"
|
||||
checklink annexedfile
|
||||
checkcontent annexedfile
|
||||
checkunwritable annexedfile
|
||||
annexed_present annexedfile
|
||||
inmainrepo $ annexed_present annexedfile
|
||||
git_annex "copy" ["-q", "--to", "origin", annexedfile] @? "copy --to of file already there failed"
|
||||
checklink annexedfile
|
||||
checkcontent annexedfile
|
||||
checkunwritable annexedfile
|
||||
annexed_present annexedfile
|
||||
inmainrepo $ annexed_present annexedfile
|
||||
git_annex "move" ["-q", "--to", "origin", annexedfile] @? "move --to of file already there failed"
|
||||
checklink annexedfile
|
||||
checkdangling annexedfile
|
||||
checkunwritable annexedfile
|
||||
annexed_notpresent annexedfile
|
||||
inmainrepo $ annexed_present annexedfile
|
||||
unannexed ingitfile
|
||||
inmainrepo $ unannexed ingitfile
|
||||
git_annex "copy" ["-q", "--to", "origin", ingitfile] @? "copy of ingitfile should be no-op"
|
||||
checkregularfile ingitfile
|
||||
checkcontent ingitfile
|
||||
unannexed ingitfile
|
||||
inmainrepo $ unannexed ingitfile
|
||||
git_annex "copy" ["-q", "--from", "origin", ingitfile] @? "copy of ingitfile should be no-op"
|
||||
checkregularfile ingitfile
|
||||
checkcontent ingitfile
|
||||
|
||||
test_lock :: Test
|
||||
test_lock = "git-annex unlock/lock" ~: intmpclonerepo $ do
|
||||
git_annex "get" ["-q", annexedfile] @? "get of file failed"
|
||||
annexed_present annexedfile
|
||||
git_annex "unlock" ["-q", annexedfile] @? "unlock failed"
|
||||
unannexed annexedfile
|
||||
-- write different content, to verify that lock
|
||||
-- throws it away
|
||||
changecontent annexedfile
|
||||
writeFile annexedfile $ (content annexedfile) ++ "foo"
|
||||
git_annex "lock" ["-q", annexedfile] @? "lock failed"
|
||||
annexed_present annexedfile
|
||||
git_annex "unlock" ["-q", annexedfile] @? "unlock failed"
|
||||
unannexed annexedfile
|
||||
changecontent annexedfile
|
||||
git_annex "add" ["-q", annexedfile] @? "add of modified file failed"
|
||||
runchecks [checklink, checkunwritable] annexedfile
|
||||
c <- readFile annexedfile
|
||||
assertEqual ("content of modified file") c (changedcontent annexedfile)
|
||||
r <- git_annex "drop" ["-q", annexedfile]
|
||||
(not r) @? "drop wrongly succeeded with no known copy of modified file"
|
||||
|
||||
test_edit :: Test
|
||||
test_edit = "git-annex edit/commit" ~: intmpclonerepo $ do
|
||||
git_annex "get" ["-q", annexedfile] @? "get of file failed"
|
||||
annexed_present annexedfile
|
||||
git_annex "edit" ["-q", annexedfile] @? "edit failed"
|
||||
unannexed annexedfile
|
||||
changecontent annexedfile
|
||||
Utility.boolSystem "git" ["commit", "-q", "-a", "-m", "content changed"]
|
||||
@? "git commit of edited file failed"
|
||||
runchecks [checklink, checkunwritable] annexedfile
|
||||
c <- readFile annexedfile
|
||||
assertEqual ("content of modified file") c (changedcontent annexedfile)
|
||||
r <- git_annex "drop" ["-q", annexedfile]
|
||||
(not r) @? "drop wrongly succeeded with no known copy of modified file"
|
||||
|
||||
test_fix :: Test
|
||||
test_fix = "git-annex fix" ~: intmpclonerepo $ do
|
||||
git_annex "get" ["-q", annexedfile] @? "get of file failed"
|
||||
annexed_present annexedfile
|
||||
createDirectory subdir
|
||||
Utility.boolSystem "git" ["mv", annexedfile, subdir]
|
||||
@? "git mv failed"
|
||||
git_annex "fix" ["-q", newfile] @? "fix failed"
|
||||
runchecks [checklink, checkunwritable] newfile
|
||||
c <- readFile newfile
|
||||
assertEqual ("content of moved file") c (content annexedfile)
|
||||
where
|
||||
subdir = "s"
|
||||
newfile = subdir ++ "/" ++ annexedfile
|
||||
|
||||
git_annex :: String -> [String] -> IO Bool
|
||||
git_annex command params = do
|
||||
|
|
@ -180,42 +237,34 @@ git_annex command params = do
|
|||
where
|
||||
run = GitAnnex.run (command:params)
|
||||
|
||||
innewrepo :: Assertion -> Test
|
||||
innewrepo a = TestCase $ withgitrepo $ \r -> indir r a
|
||||
innewrepo :: Assertion -> Assertion
|
||||
innewrepo a = withgitrepo $ \r -> indir r a
|
||||
|
||||
inoldrepo :: Assertion -> Test
|
||||
inoldrepo a = TestCase $ indir repodir a
|
||||
inmainrepo :: Assertion -> Assertion
|
||||
inmainrepo a = indir mainrepodir a
|
||||
|
||||
intmpcopyrepo :: Assertion -> Test
|
||||
intmpcopyrepo a = TestCase $ withtmpcopyrepo $ \r -> indir r a
|
||||
intmpcopyrepo :: Assertion -> Assertion
|
||||
intmpcopyrepo a = withtmpcopyrepo $ \r -> indir r a
|
||||
|
||||
intmpclonerepo :: Assertion -> Test
|
||||
intmpclonerepo a = TestCase $ withtmpclonerepo $ \r -> indir r a
|
||||
intmpclonerepo :: Assertion -> Assertion
|
||||
intmpclonerepo a = withtmpclonerepo $ \r -> indir r a
|
||||
|
||||
withtmpcopyrepo :: (FilePath -> Assertion) -> Assertion
|
||||
withtmpcopyrepo = bracket (copyrepo repodir tmprepodir) cleanup
|
||||
withtmpcopyrepo = bracket (copyrepo mainrepodir tmprepodir) cleanup
|
||||
|
||||
withtmpclonerepo :: (FilePath -> Assertion) -> Assertion
|
||||
withtmpclonerepo = bracket (clonerepo repodir tmprepodir) cleanup
|
||||
withtmpclonerepo = bracket (clonerepo mainrepodir tmprepodir) cleanup
|
||||
|
||||
withgitrepo :: (FilePath -> Assertion) -> Assertion
|
||||
withgitrepo = bracket (setuprepo repodir) return
|
||||
withgitrepo = bracket (setuprepo mainrepodir) return
|
||||
|
||||
indir :: FilePath -> Assertion -> Assertion
|
||||
indir dir a = do
|
||||
cwd <- getCurrentDirectory
|
||||
bracket_ (changeWorkingDirectory $ dir)
|
||||
bracket_ (changeToTmpDir $ dir)
|
||||
(\_ -> changeWorkingDirectory cwd)
|
||||
a
|
||||
|
||||
-- While PATH is mostly avoided, the commit hook does run it. Make
|
||||
-- sure that the just-built git annex is used.
|
||||
tweakpath :: IO ()
|
||||
tweakpath = do
|
||||
cwd <- getCurrentDirectory
|
||||
p <- getEnvDefault "PATH" ""
|
||||
setEnv "PATH" (cwd ++ ":" ++ p) True
|
||||
|
||||
setuprepo :: FilePath -> IO FilePath
|
||||
setuprepo dir = do
|
||||
cleanup dir
|
||||
|
|
@ -225,6 +274,8 @@ setuprepo dir = do
|
|||
|
||||
copyrepo :: FilePath -> FilePath -> IO FilePath
|
||||
copyrepo old new = do
|
||||
_ <- clonerepo old new
|
||||
indir new $ Utility.boolSystem "git" ["remote", "rm", "origin"] @? "git remote failed"
|
||||
cleanup new
|
||||
ensuretmpdir
|
||||
Utility.boolSystem "cp" ["-pr", old, new] @? "cp -pr failed"
|
||||
|
|
@ -236,6 +287,7 @@ clonerepo old new = do
|
|||
cleanup new
|
||||
ensuretmpdir
|
||||
Utility.boolSystem "git" ["clone", "-q", old, new] @? "git clone failed"
|
||||
indir new $ git_annex "init" ["-q", new] @? "git annex init failed"
|
||||
return new
|
||||
|
||||
ensuretmpdir :: IO ()
|
||||
|
|
@ -271,11 +323,18 @@ checkcontent f = do
|
|||
|
||||
checkunwritable :: FilePath -> Assertion
|
||||
checkunwritable f = do
|
||||
r <- try $ writeFile f $ "dummy"
|
||||
r <- try $ writeFile f $ content f
|
||||
case r of
|
||||
Left _ -> return () -- expected permission error
|
||||
Right _ -> assertFailure $ "was able to modify annexed file's " ++ f ++ " content"
|
||||
|
||||
checkwritable :: FilePath -> Assertion
|
||||
checkwritable f = do
|
||||
r <- try $ writeFile f $ content f
|
||||
case r of
|
||||
Left _ -> assertFailure $ "unable to modify " ++ f
|
||||
Right _ -> return ()
|
||||
|
||||
checkdangling :: FilePath -> Assertion
|
||||
checkdangling f = do
|
||||
r <- try $ readFile f
|
||||
|
|
@ -283,15 +342,45 @@ checkdangling f = do
|
|||
Left _ -> return () -- expected; dangling link
|
||||
Right _ -> assertFailure $ f ++ " was not a dangling link as expected"
|
||||
|
||||
tmpdir :: String
|
||||
runchecks :: [FilePath -> Assertion] -> FilePath -> Assertion
|
||||
runchecks [] _ = return ()
|
||||
runchecks (a:as) f = do
|
||||
a f
|
||||
runchecks as f
|
||||
|
||||
annexed_notpresent :: FilePath -> Assertion
|
||||
annexed_notpresent = runchecks [checklink, checkdangling, checkunwritable]
|
||||
|
||||
annexed_present :: FilePath -> Assertion
|
||||
annexed_present = runchecks [checklink, checkcontent, checkunwritable]
|
||||
|
||||
unannexed :: FilePath -> Assertion
|
||||
unannexed = runchecks [checkregularfile, checkcontent, checkwritable]
|
||||
|
||||
prepare :: IO ()
|
||||
prepare = do
|
||||
-- While PATH is mostly avoided, the commit hook does run it. Make
|
||||
-- sure that the just-built git annex is used.
|
||||
cwd <- getCurrentDirectory
|
||||
p <- getEnvDefault "PATH" ""
|
||||
setEnv "PATH" (cwd ++ ":" ++ p) True
|
||||
setEnv "TOPDIR" cwd True
|
||||
|
||||
changeToTmpDir :: FilePath -> IO ()
|
||||
changeToTmpDir t = do
|
||||
-- Hack alert. Threading state to here was too much bother.
|
||||
topdir <- getEnvDefault "TOPDIR" ""
|
||||
changeWorkingDirectory $ topdir ++ "/" ++ t
|
||||
|
||||
tmpdir :: String
|
||||
tmpdir = ".t"
|
||||
|
||||
repodir :: String
|
||||
repodir = tmpdir ++ "/repo"
|
||||
mainrepodir :: String
|
||||
mainrepodir = tmpdir ++ "/repo"
|
||||
|
||||
tmprepodir :: String
|
||||
tmprepodir = tmpdir ++ "/tmprepo"
|
||||
|
||||
|
||||
annexedfile :: String
|
||||
annexedfile = "foo"
|
||||
|
||||
|
|
@ -303,3 +392,9 @@ content f
|
|||
| f == annexedfile = "annexed file content"
|
||||
| f == ingitfile = "normal file content"
|
||||
| otherwise = "unknown file " ++ f
|
||||
|
||||
changecontent :: FilePath -> IO ()
|
||||
changecontent f = writeFile f $ changedcontent f
|
||||
|
||||
changedcontent :: FilePath -> String
|
||||
changedcontent f = (content f) ++ " (modified)"
|
||||
|
|
|
|||
Loading…
Reference in a new issue