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

add tests of setkey/fromkey

Browse source
This commit is contained in:
Joey Hess 2011-01-11 19:59:11 -04:00
parent e2af0914fa
commit 485dbdd1a9
1 changed files with 20 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

22
test.hs
View file

@ -18,6 +18,7 @@ import System.Posix.Env
import qualified Control.Exception.Extensible as E import qualified Control.Exception.Extensible as E
import Control.Exception (throw) import Control.Exception (throw)
import Control.Monad.State (liftIO) import Control.Monad.State (liftIO)
import Maybe
import qualified Annex import qualified Annex
import qualified BackendList import qualified BackendList
@ -31,6 +32,7 @@ import qualified LocationLog
import qualified UUID import qualified UUID
import qualified Remotes import qualified Remotes
import qualified Core import qualified Core
import qualified Backend.SHA1
main :: IO () main :: IO ()
main = do main = do
@ -60,6 +62,7 @@ toplevels = TestLabel "toplevel" $ TestList
-- test order matters, later tests may rely on state from earlier -- test order matters, later tests may rely on state from earlier
[ test_init [ test_init
, test_add , test_add
, test_setkey
, test_unannex , test_unannex
, test_drop , test_drop
, test_get , test_get
@ -94,6 +97,17 @@ test_add = "git-annex add" ~: TestCase $ inmainrepo $ do
git_annex "add" ["-q", ingitfile] @? "add ingitfile should be no-op" git_annex "add" ["-q", ingitfile] @? "add ingitfile should be no-op"
unannexed ingitfile unannexed ingitfile
test_setkey :: Test
test_setkey = "git-annex setkey/fromkey" ~: TestCase $ inmainrepo $ do
writeFile tmp $ content sha1annexedfile
r <- annexeval $ TypeInternals.getKey Backend.SHA1.backend tmp
let sha1 = TypeInternals.keyName $ fromJust r
git_annex "setkey" ["-q", "--backend", "SHA1", "--key", sha1, tmp] @? "setkey failed"
git_annex "fromkey" ["-q", "--backend", "SHA1", "--key", sha1, sha1annexedfile] @? "fromkey failed"
annexed_present sha1annexedfile
where
tmp = "tmpfile"
test_unannex :: Test test_unannex :: Test
test_unannex = "git-annex unannex" ~: TestList [nocopy, withcopy] test_unannex = "git-annex unannex" ~: TestList [nocopy, withcopy]
where where
@ -281,8 +295,8 @@ test_fsck = "git-annex fsck" ~: intmpclonerepo $ do
git_annex "get" ["-q", annexedfile] @? "get of file failed" git_annex "get" ["-q", annexedfile] @? "get of file failed"
Core.allowWrite annexedfile Core.allowWrite annexedfile
writeFile annexedfile (changedcontent annexedfile) writeFile annexedfile (changedcontent annexedfile)
r <- git_annex "fsck" ["-q"] r' <- git_annex "fsck" ["-q"]
not r @? "fsck failed to fail with corrupted file content" not r' @? "fsck failed to fail with corrupted file content"
-- This is equivilant to running git-annex, but it's all run in-process -- This is equivilant to running git-annex, but it's all run in-process
-- so test coverage collection works. -- so test coverage collection works.
@ -494,6 +508,9 @@ tmprepodir = tmpdir ++ "/tmprepo"
annexedfile :: String annexedfile :: String
annexedfile = "foo" annexedfile = "foo"
sha1annexedfile :: String
sha1annexedfile = "sha1foo"
ingitfile :: String ingitfile :: String
ingitfile = "bar" ingitfile = "bar"
@ -501,6 +518,7 @@ content :: FilePath -> String
content f content f
| f == annexedfile = "annexed file content" | f == annexedfile = "annexed file content"
| f == ingitfile = "normal file content" | f == ingitfile = "normal file content"
| f == sha1annexedfile ="sha1 annexed file content"
| otherwise = "unknown file " ++ f | otherwise = "unknown file " ++ f
changecontent :: FilePath -> IO () changecontent :: FilePath -> IO ()