From f3472d3a5d71ffedc67ed212b87308052bb4c042 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 7 Jan 2011 14:06:32 -0400 Subject: Test suite improvements. Current top-level test coverage: 65% --- debian/changelog | 2 +- test.hs | 273 +++++++++++++++++++++++++++++++++++++------------------ 2 files changed, 185 insertions(+), 90 deletions(-) diff --git a/debian/changelog b/debian/changelog index b31a63b28..ead272dbe 100644 --- a/debian/changelog +++ b/debian/changelog @@ -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 Tue, 04 Jan 2011 17:33:42 -0400 diff --git a/test.hs b/test.hs index 18ccf331a..e5563c514 100644 --- a/test.hs +++ b/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)" -- cgit v1.2.3