diff options
author | 2011-01-06 21:39:26 -0400 | |
---|---|---|
committer | 2011-01-06 21:39:26 -0400 | |
commit | 87f424eca7f8d9ce7a437fb3756755c042fe9002 (patch) | |
tree | bc968a11946f0fd212de1cfc950e6c4afa336a83 /test.hs | |
parent | 2533d826fc265b56556f8a6b9759d98771f79f53 (diff) |
more tests
Diffstat (limited to 'test.hs')
-rw-r--r-- | test.hs | 139 |
1 files changed, 106 insertions, 33 deletions
@@ -14,6 +14,7 @@ import IO (bracket_, bracket) import Control.Monad (unless, when) import Data.List import System.IO.Error +import qualified Control.Exception.Extensible as E import qualified GitRepo as Git import qualified Locations @@ -23,7 +24,10 @@ import qualified GitAnnex import qualified CmdLine main :: IO (Counts, Int) -main = runVerboseTests $ TestList [quickchecks, toplevels] +main = do + r <- runVerboseTests $ TestList [quickchecks, toplevels] + cleanup tmpdir + return r quickchecks :: Test quickchecks = TestLabel "quickchecks" $ TestList @@ -38,12 +42,15 @@ quickchecks = TestLabel "quickchecks" $ TestList toplevels :: Test toplevels = TestLabel "toplevel" $ TestList + -- test order matters, later tests may rely on state from earlier [ test_init , test_add + , test_unannex + , test_drop ] test_init :: Test -test_init = TestLabel "git-annex init" $ TestCase $ ingitrepo $ do +test_init = TestLabel "git-annex init" $ TestCase $ innewrepo $ do git_annex "init" ["-q", reponame] @? "init failed" e <- doesFileExist annexlog unless e $ @@ -56,7 +63,7 @@ test_init = TestLabel "git-annex init" $ TestCase $ ingitrepo $ do reponame = "test repo" test_add :: Test -test_add = TestLabel "git-annex add" $ TestCase $ inannex $ do +test_add = TestLabel "git-annex add" $ TestCase $ inoldrepo $ do writeFile file content git_annex "add" ["-q", "foo"] @? "add failed" s <- getSymbolicLinkStatus file @@ -65,7 +72,7 @@ test_add = TestLabel "git-annex add" $ TestCase $ inannex $ do c <- readFile file unless (c == content) $ assertFailure "file content changed during git-annex add" - r <- try (writeFile file $ content++"bar") + r <- try $ writeFile file $ content++"bar" case r of Left _ -> return () -- expected permission error Right _ -> assertFailure "was able to modify annexed file content" @@ -73,47 +80,113 @@ test_add = TestLabel "git-annex add" $ TestCase $ inannex $ do file = "foo" content = "foo file content" +test_unannex :: Test +test_unannex = TestLabel "git-annex unannex" $ TestCase $ intmpcopyrepo $ do + git_annex "unannex" ["-q", "foo"] @? "unannex failed" + s <- getSymbolicLinkStatus "foo" + when (isSymbolicLink s) $ + assertFailure "git-annex unannex left symlink" + +test_drop :: Test +test_drop = TestLabel "git-annex drop" $ TestCase $ intmpcopyrepo $ do + r <- git_annex "drop" ["-q", "foo"] + (not r) @? "drop wrongly succeeded with no known copy of file" + checklink + git_annex "drop" ["-q", "--force", "foo"] @? "drop --force failed" + checklink + r' <- try $ readFile "foo" + case r' of + Left _ -> return () -- expected; dangling link + Right _ -> assertFailure "drop did not remove file content" + where + checklink = do + s <- getSymbolicLinkStatus "foo" + unless (isSymbolicLink s) $ + assertFailure "git-annex drop killed symlink" + + + + git_annex :: String -> [String] -> IO Bool git_annex command params = do - gitrepo <- Git.repoFromCwd - r <- try $ - CmdLine.dispatch gitrepo (command:params) - GitAnnex.cmds GitAnnex.options GitAnnex.header + -- catch all errors, including normally fatal errors + r <- E.try (run)::IO (Either E.SomeException ()) case r of Right _ -> return True Left _ -> return False + where + run = do + gitrepo <- Git.repoFromCwd + CmdLine.dispatch gitrepo (command:params) + GitAnnex.cmds GitAnnex.options GitAnnex.header -inannex :: Assertion -> Assertion -inannex a = ingitrepo $ do +innewannex :: Assertion -> Assertion +innewannex a = innewrepo $ do git_annex "init" ["-q", reponame] @? "init failed" a where reponame = "test repo" -ingitrepo :: Assertion -> Assertion -ingitrepo a = withgitrepo $ \r -> do +innewrepo :: Assertion -> Assertion +innewrepo a = withgitrepo $ \r -> indir r a + +inoldrepo :: Assertion -> Assertion +inoldrepo = indir repodir + +intmpcopyrepo :: Assertion -> Assertion +intmpcopyrepo a = withtmpcopyrepo $ \r -> indir r a + +withtmpcopyrepo :: (FilePath -> Assertion) -> Assertion +withtmpcopyrepo = bracket (copyrepo repodir tmprepodir) cleanup + +withgitrepo :: (FilePath -> Assertion) -> Assertion +withgitrepo = bracket (setuprepo repodir) return + +indir :: FilePath -> Assertion -> Assertion +indir dir a = do cwd <- getCurrentDirectory - bracket_ (changeWorkingDirectory $ Git.workTree r) + bracket_ (changeWorkingDirectory $ dir) (\_ -> changeWorkingDirectory cwd) a -withgitrepo :: (Git.Repo -> Assertion) -> Assertion -withgitrepo = bracket setup cleanup - where - tmpdir = ".t" - repodir = tmpdir ++ "/repo" - setup = do - cleanup True - createDirectory tmpdir - ok <- Utility.boolSystem "git" ["init", "-q", repodir] - unless ok $ - assertFailure "git init failed" - return $ Git.repoFromPath repodir - cleanup _ = do - e <- doesDirectoryExist tmpdir - when e $ do - -- git-annex prevents annexed file content - -- from being removed with permissions - -- bits; undo - _ <- Utility.boolSystem "chmod" ["+rw", "-R", tmpdir] - removeDirectoryRecursive tmpdir +setuprepo :: FilePath -> IO FilePath +setuprepo dir = do + cleanup dir + ensuretmpdir + ok <- Utility.boolSystem "git" ["init", "-q", dir] + unless ok $ + assertFailure "git init failed" + return dir + +copyrepo :: FilePath -> FilePath -> IO FilePath +copyrepo old new = do + cleanup new + ensuretmpdir + ok <- Utility.boolSystem "cp" ["-pr", old, new] + unless ok $ + assertFailure "cp -pr failed" + return new + +ensuretmpdir :: IO () +ensuretmpdir = do + e <- doesDirectoryExist tmpdir + unless e $ + createDirectory tmpdir + +cleanup :: FilePath -> IO () +cleanup dir = do + e <- doesDirectoryExist dir + when e $ do + -- git-annex prevents annexed file content from being + -- removed via permissions bits; undo + _ <- Utility.boolSystem "chmod" ["+rw", "-R", dir] + removeDirectoryRecursive dir + +tmpdir :: String +tmpdir = ".t" + +repodir :: String +repodir = tmpdir ++ "/repo" + +tmprepodir :: String +tmprepodir = tmpdir ++ "/tmprepo" |