Test suite improvements. Current top-level test coverage: 65%

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 <joeyh@debian.org>  Tue, 04 Jan 2011 17:33:42 -0400
 

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
+	annexed_present annexedfile
-	checkcontent annexedfile
-	checkunwritable 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
+test_drop = "git-annex drop" ~: TestList [nocopy, withcopy]
-	r <- git_annex "drop" ["-q", annexedfile]
+	where
-	(not r) @? "drop wrongly succeeded with no known copy of file"
+		nocopy = "no remotes" ~: TestCase $ intmpcopyrepo $ do
-	checklink annexedfile
+			r <- git_annex "drop" ["-q", annexedfile]
-	checkcontent annexedfile
+			(not r) @? "drop wrongly succeeded with no known copy of file"
-	git_annex "drop" ["-q", "--force", annexedfile] @? "drop --force failed"
+			annexed_present annexedfile
-	checklink annexedfile
+			git_annex "drop" ["-q", "--force", annexedfile] @? "drop --force failed"
-	checkdangling annexedfile
+			annexed_notpresent annexedfile
-	checkunwritable annexedfile
+			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
-	checkregularfile ingitfile
+		withcopy = "with remote" ~: TestCase $ intmpclonerepo $ do
-	checkcontent ingitfile
+			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
+	inmainrepo $ annexed_present annexedfile
-	checkcontent annexedfile
+	annexed_present annexedfile
-	checkunwritable annexedfile
 	git_annex "get" ["-q", annexedfile] @? "get of file already here failed"
-	checklink annexedfile
+	inmainrepo $ annexed_present annexedfile
-	checkcontent annexedfile
+	annexed_present annexedfile
-	checkunwritable annexedfile
+	inmainrepo $ unannexed ingitfile
+	unannexed ingitfile
 	git_annex "get" ["-q", ingitfile] @? "get ingitfile should be no-op"
-	checkregularfile ingitfile
+	inmainrepo $ unannexed ingitfile
-	checkcontent 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
+	annexed_present annexedfile
-	checkcontent annexedfile
+	inmainrepo $ annexed_notpresent annexedfile
-	checkunwritable annexedfile
 	git_annex "move" ["-q", "--from", "origin", annexedfile] @? "move --from of file already here failed"
-	checklink annexedfile
+	annexed_present annexedfile
-	checkcontent annexedfile
+	inmainrepo $ annexed_notpresent annexedfile
-	checkunwritable annexedfile
 	git_annex "move" ["-q", "--to", "origin", annexedfile] @? "move --to of file failed"
-	checklink annexedfile
+	inmainrepo $ annexed_present annexedfile
-	checkdangling annexedfile
+	annexed_notpresent annexedfile
-	checkunwritable annexedfile
 	git_annex "move" ["-q", "--to", "origin", annexedfile] @? "move --to of file already there failed"
-	checklink annexedfile
+	inmainrepo $ annexed_present annexedfile
-	checkdangling annexedfile
+	annexed_notpresent annexedfile
-	checkunwritable annexedfile
+	unannexed ingitfile
+	inmainrepo $ unannexed ingitfile
 	git_annex "move" ["-q", "--to", "origin", ingitfile] @? "move of ingitfile should be no-op"
-	checkregularfile ingitfile
+	unannexed ingitfile
-	checkcontent ingitfile
+	inmainrepo $ unannexed ingitfile
 	git_annex "move" ["-q", "--from", "origin", ingitfile] @? "move of ingitfile should be no-op"
-	checkregularfile ingitfile
+	unannexed ingitfile
-	checkcontent 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
+	annexed_present annexedfile
-	checkcontent annexedfile
+	inmainrepo $ annexed_present annexedfile
-	checkunwritable annexedfile
 	git_annex "copy" ["-q", "--from", "origin", annexedfile] @? "copy --from of file already here failed"
-	checklink annexedfile
+	annexed_present annexedfile
-	checkcontent annexedfile
+	inmainrepo $ annexed_present annexedfile
-	checkunwritable annexedfile
 	git_annex "copy" ["-q", "--to", "origin", annexedfile] @? "copy --to of file already there failed"
-	checklink annexedfile
+	annexed_present annexedfile
-	checkcontent annexedfile
+	inmainrepo $ annexed_present annexedfile
-	checkunwritable annexedfile
 	git_annex "move" ["-q", "--to", "origin", annexedfile] @? "move --to of file already there failed"
-	checklink annexedfile
+	annexed_notpresent annexedfile
-	checkdangling annexedfile
+	inmainrepo $ annexed_present annexedfile
-	checkunwritable annexedfile
+	unannexed ingitfile
+	inmainrepo $ unannexed ingitfile
 	git_annex "copy" ["-q", "--to", "origin", ingitfile] @? "copy of ingitfile should be no-op"
-	checkregularfile ingitfile
+	unannexed ingitfile
-	checkcontent 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 :: Assertion -> Assertion
-innewrepo a = TestCase $ withgitrepo $ \r -> indir r a
+innewrepo a = withgitrepo $ \r -> indir r a
 
-inoldrepo :: Assertion -> Test
+inmainrepo :: Assertion -> Assertion
-inoldrepo a = TestCase $ indir repodir a
+inmainrepo a = indir mainrepodir a
 
-intmpcopyrepo :: Assertion -> Test
+intmpcopyrepo :: Assertion -> Assertion
-intmpcopyrepo a = TestCase $ withtmpcopyrepo $ \r -> indir r a
+intmpcopyrepo a = withtmpcopyrepo $ \r -> indir r a
 
-intmpclonerepo :: Assertion -> Test
+intmpclonerepo :: Assertion -> Assertion
-intmpclonerepo a = TestCase $ withtmpclonerepo $ \r -> indir r a
+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,11 +342,41 @@ checkdangling f = do
 		Left _ -> return () -- expected; dangling link
 		Right _ -> assertFailure $ f ++ " was not a dangling link as expected"
 
+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
+mainrepodir :: String
-repodir = tmpdir ++ "/repo"
+mainrepodir = tmpdir ++ "/repo"
 
 tmprepodir :: String
 tmprepodir = tmpdir ++ "/tmprepo"
@@ -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)"