summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2013-05-15 17:22:45 -0400
committerGravatar Joey Hess <joey@kitenet.net>2013-05-15 17:22:45 -0400
commit9eed3371174c8ed3796bf83a1e7ca99e125576e4 (patch)
tree6cdd984fc0639a072997b27ec2bdfe89fa82370e
parentb77629e93b1c989b16d9093dba424641671a51b0 (diff)
thread env through test suite
This will allow porting it to Windows, which cannot set environment except when forking processes. This is nasty, but HUnit can only test the IO monad, so I cannot use a Reader monad.
-rw-r--r--Test.hs654
1 files changed, 332 insertions, 322 deletions
diff --git a/Test.hs b/Test.hs
index bc603b004..f3969418b 100644
--- a/Test.hs
+++ b/Test.hs
@@ -54,6 +54,8 @@ import qualified Utility.Misc
import qualified Utility.InodeCache
import qualified Utility.Env
+type TestEnv = M.Map String String
+
main :: IO ()
main = do
divider
@@ -64,10 +66,10 @@ main = do
putStrLn "Now, some broader checks ..."
putStrLn " (Do not be alarmed by odd output here; it's normal."
putStrLn " wait for the last line to see how it went.)"
- prepare
+ env <- prepare
rs <- forM hunit $ \t -> do
divider
- t
+ t env
cleanup tmpdir
divider
propigate rs qcok
@@ -119,7 +121,7 @@ quickcheck =
putStrLn desc
quickCheckResult prop
-hunit :: [IO Counts]
+hunit :: [TestEnv -> IO Counts]
hunit =
-- test order matters, later tests may rely on state from earlier
[ check "init" test_init
@@ -155,210 +157,210 @@ hunit =
, check "crypto" test_crypto
]
where
- check desc t = do
+ check desc t env = do
putStrLn desc
- runTestTT t
+ runTestTT (t env)
-test_init :: Test
-test_init = "git-annex init" ~: TestCase $ innewrepo $ do
- git_annex "init" [reponame] @? "init failed"
+test_init :: TestEnv -> Test
+test_init env = "git-annex init" ~: TestCase $ innewrepo env $ do
+ git_annex env "init" [reponame] @? "init failed"
where
reponame = "test repo"
-test_add :: Test
-test_add = "git-annex add" ~: TestList [basic, sha1dup, subdirs]
+test_add :: TestEnv -> Test
+test_add env = "git-annex add" ~: TestList [basic, sha1dup, subdirs]
where
-- this test case runs in the main repo, to set up a basic
-- annexed file that later tests will use
- basic = TestCase $ inmainrepo $ do
+ basic = TestCase $ inmainrepo env $ do
writeFile annexedfile $ content annexedfile
- git_annex "add" [annexedfile] @? "add failed"
+ git_annex env "add" [annexedfile] @? "add failed"
annexed_present annexedfile
writeFile sha1annexedfile $ content sha1annexedfile
- git_annex "add" [sha1annexedfile, "--backend=SHA1"] @? "add with SHA1 failed"
+ git_annex env "add" [sha1annexedfile, "--backend=SHA1"] @? "add with SHA1 failed"
annexed_present sha1annexedfile
checkbackend sha1annexedfile backendSHA1
writeFile wormannexedfile $ content wormannexedfile
- git_annex "add" [wormannexedfile, "--backend=WORM"] @? "add with WORM failed"
+ git_annex env "add" [wormannexedfile, "--backend=WORM"] @? "add with WORM failed"
annexed_present wormannexedfile
checkbackend wormannexedfile backendWORM
boolSystem "git" [Params "rm --force -q", File wormannexedfile] @? "git rm failed"
writeFile ingitfile $ content ingitfile
boolSystem "git" [Param "add", File ingitfile] @? "git add failed"
boolSystem "git" [Params "commit -q -a -m commit"] @? "git commit failed"
- git_annex "add" [ingitfile] @? "add ingitfile should be no-op"
+ git_annex env "add" [ingitfile] @? "add ingitfile should be no-op"
unannexed ingitfile
- sha1dup = TestCase $ intmpclonerepo $ do
+ sha1dup = TestCase $ intmpclonerepo env $ do
writeFile sha1annexedfiledup $ content sha1annexedfiledup
- git_annex "add" [sha1annexedfiledup, "--backend=SHA1"] @? "add of second file with same SHA1 failed"
+ git_annex env "add" [sha1annexedfiledup, "--backend=SHA1"] @? "add of second file with same SHA1 failed"
annexed_present sha1annexedfiledup
annexed_present sha1annexedfile
- subdirs = TestCase $ intmpclonerepo $ do
+ subdirs = TestCase $ intmpclonerepo env $ do
createDirectory "dir"
writeFile "dir/foo" $ content annexedfile
- git_annex "add" ["dir"] @? "add of subdir failed"
+ git_annex env "add" ["dir"] @? "add of subdir failed"
createDirectory "dir2"
writeFile "dir2/foo" $ content annexedfile
setCurrentDirectory "dir"
- git_annex "add" ["../dir2"] @? "add of ../subdir failed"
+ git_annex env "add" ["../dir2"] @? "add of ../subdir failed"
-test_reinject :: Test
-test_reinject = "git-annex reinject/fromkey" ~: TestCase $ intmpclonerepo $ do
- git_annex "drop" ["--force", sha1annexedfile] @? "drop failed"
+test_reinject :: TestEnv -> Test
+test_reinject env = "git-annex reinject/fromkey" ~: TestCase $ intmpclonerepo env $ do
+ git_annex env "drop" ["--force", sha1annexedfile] @? "drop failed"
writeFile tmp $ content sha1annexedfile
r <- annexeval $ Types.Backend.getKey backendSHA1 $
Types.KeySource.KeySource { Types.KeySource.keyFilename = tmp, Types.KeySource.contentLocation = tmp, Types.KeySource.inodeCache = Nothing }
let key = Types.Key.key2file $ fromJust r
- git_annex "reinject" [tmp, sha1annexedfile] @? "reinject failed"
- git_annex "fromkey" [key, sha1annexedfiledup] @? "fromkey failed"
+ git_annex env "reinject" [tmp, sha1annexedfile] @? "reinject failed"
+ git_annex env "fromkey" [key, sha1annexedfiledup] @? "fromkey failed"
annexed_present sha1annexedfiledup
where
tmp = "tmpfile"
-test_unannex :: Test
-test_unannex = "git-annex unannex" ~: TestList [nocopy, withcopy]
+test_unannex :: TestEnv -> Test
+test_unannex env = "git-annex unannex" ~: TestList [nocopy, withcopy]
where
- nocopy = "no content" ~: intmpclonerepo $ do
+ nocopy = "no content" ~: intmpclonerepo env $ do
annexed_notpresent annexedfile
- git_annex "unannex" [annexedfile] @? "unannex failed with no copy"
+ git_annex env "unannex" [annexedfile] @? "unannex failed with no copy"
annexed_notpresent annexedfile
- withcopy = "with content" ~: intmpclonerepo $ do
- git_annex "get" [annexedfile] @? "get failed"
+ withcopy = "with content" ~: intmpclonerepo env $ do
+ git_annex env "get" [annexedfile] @? "get failed"
annexed_present annexedfile
- git_annex "unannex" [annexedfile, sha1annexedfile] @? "unannex failed"
+ git_annex env "unannex" [annexedfile, sha1annexedfile] @? "unannex failed"
unannexed annexedfile
- git_annex "unannex" [annexedfile] @? "unannex failed on non-annexed file"
+ git_annex env "unannex" [annexedfile] @? "unannex failed on non-annexed file"
unannexed annexedfile
- git_annex "unannex" [ingitfile] @? "unannex ingitfile should be no-op"
+ git_annex env "unannex" [ingitfile] @? "unannex ingitfile should be no-op"
unannexed ingitfile
-test_drop :: Test
-test_drop = "git-annex drop" ~: TestList [noremote, withremote, untrustedremote]
+test_drop :: TestEnv -> Test
+test_drop env = "git-annex drop" ~: TestList [noremote, withremote, untrustedremote]
where
- noremote = "no remotes" ~: TestCase $ intmpclonerepo $ do
- git_annex "get" [annexedfile] @? "get failed"
+ noremote = "no remotes" ~: TestCase $ intmpclonerepo env $ do
+ git_annex env "get" [annexedfile] @? "get failed"
boolSystem "git" [Params "remote rm origin"]
@? "git remote rm origin failed"
- not <$> git_annex "drop" [annexedfile] @? "drop wrongly succeeded with no known copy of file"
+ not <$> git_annex env "drop" [annexedfile] @? "drop wrongly succeeded with no known copy of file"
annexed_present annexedfile
- git_annex "drop" ["--force", annexedfile] @? "drop --force failed"
+ git_annex env "drop" ["--force", annexedfile] @? "drop --force failed"
annexed_notpresent annexedfile
- git_annex "drop" [annexedfile] @? "drop of dropped file failed"
- git_annex "drop" [ingitfile] @? "drop ingitfile should be no-op"
+ git_annex env "drop" [annexedfile] @? "drop of dropped file failed"
+ git_annex env "drop" [ingitfile] @? "drop ingitfile should be no-op"
unannexed ingitfile
- withremote = "with remote" ~: TestCase $ intmpclonerepo $ do
- git_annex "get" [annexedfile] @? "get failed"
+ withremote = "with remote" ~: TestCase $ intmpclonerepo env $ do
+ git_annex env "get" [annexedfile] @? "get failed"
annexed_present annexedfile
- git_annex "drop" [annexedfile] @? "drop failed though origin has copy"
+ git_annex env "drop" [annexedfile] @? "drop failed though origin has copy"
annexed_notpresent annexedfile
- inmainrepo $ annexed_present annexedfile
- untrustedremote = "untrusted remote" ~: TestCase $ intmpclonerepo $ do
- git_annex "untrust" ["origin"] @? "untrust of origin failed"
- git_annex "get" [annexedfile] @? "get failed"
+ inmainrepo env $ annexed_present annexedfile
+ untrustedremote = "untrusted remote" ~: TestCase $ intmpclonerepo env $ do
+ git_annex env "untrust" ["origin"] @? "untrust of origin failed"
+ git_annex env "get" [annexedfile] @? "get failed"
annexed_present annexedfile
- not <$> git_annex "drop" [annexedfile] @? "drop wrongly suceeded with only an untrusted copy of the file"
+ not <$> git_annex env "drop" [annexedfile] @? "drop wrongly suceeded with only an untrusted copy of the file"
annexed_present annexedfile
- inmainrepo $ annexed_present annexedfile
+ inmainrepo env $ annexed_present annexedfile
-test_get :: Test
-test_get = "git-annex get" ~: TestCase $ intmpclonerepo $ do
- inmainrepo $ annexed_present annexedfile
+test_get :: TestEnv -> Test
+test_get env = "git-annex get" ~: TestCase $ intmpclonerepo env $ do
+ inmainrepo env $ annexed_present annexedfile
annexed_notpresent annexedfile
- git_annex "get" [annexedfile] @? "get of file failed"
- inmainrepo $ annexed_present annexedfile
+ git_annex env "get" [annexedfile] @? "get of file failed"
+ inmainrepo env $ annexed_present annexedfile
annexed_present annexedfile
- git_annex "get" [annexedfile] @? "get of file already here failed"
- inmainrepo $ annexed_present annexedfile
+ git_annex env "get" [annexedfile] @? "get of file already here failed"
+ inmainrepo env $ annexed_present annexedfile
annexed_present annexedfile
- inmainrepo $ unannexed ingitfile
+ inmainrepo env $ unannexed ingitfile
unannexed ingitfile
- git_annex "get" [ingitfile] @? "get ingitfile should be no-op"
- inmainrepo $ unannexed ingitfile
+ git_annex env "get" [ingitfile] @? "get ingitfile should be no-op"
+ inmainrepo env $ unannexed ingitfile
unannexed ingitfile
-test_move :: Test
-test_move = "git-annex move" ~: TestCase $ intmpclonerepo $ do
+test_move :: TestEnv -> Test
+test_move env = "git-annex move" ~: TestCase $ intmpclonerepo env $ do
annexed_notpresent annexedfile
- inmainrepo $ annexed_present annexedfile
- git_annex "move" ["--from", "origin", annexedfile] @? "move --from of file failed"
+ inmainrepo env $ annexed_present annexedfile
+ git_annex env "move" ["--from", "origin", annexedfile] @? "move --from of file failed"
annexed_present annexedfile
- inmainrepo $ annexed_notpresent annexedfile
- git_annex "move" ["--from", "origin", annexedfile] @? "move --from of file already here failed"
+ inmainrepo env $ annexed_notpresent annexedfile
+ git_annex env "move" ["--from", "origin", annexedfile] @? "move --from of file already here failed"
annexed_present annexedfile
- inmainrepo $ annexed_notpresent annexedfile
- git_annex "move" ["--to", "origin", annexedfile] @? "move --to of file failed"
- inmainrepo $ annexed_present annexedfile
+ inmainrepo env $ annexed_notpresent annexedfile
+ git_annex env "move" ["--to", "origin", annexedfile] @? "move --to of file failed"
+ inmainrepo env $ annexed_present annexedfile
annexed_notpresent annexedfile
- git_annex "move" ["--to", "origin", annexedfile] @? "move --to of file already there failed"
- inmainrepo $ annexed_present annexedfile
+ git_annex env "move" ["--to", "origin", annexedfile] @? "move --to of file already there failed"
+ inmainrepo env $ annexed_present annexedfile
annexed_notpresent annexedfile
unannexed ingitfile
- inmainrepo $ unannexed ingitfile
- git_annex "move" ["--to", "origin", ingitfile] @? "move of ingitfile should be no-op"
+ inmainrepo env $ unannexed ingitfile
+ git_annex env "move" ["--to", "origin", ingitfile] @? "move of ingitfile should be no-op"
unannexed ingitfile
- inmainrepo $ unannexed ingitfile
- git_annex "move" ["--from", "origin", ingitfile] @? "move of ingitfile should be no-op"
+ inmainrepo env $ unannexed ingitfile
+ git_annex env "move" ["--from", "origin", ingitfile] @? "move of ingitfile should be no-op"
unannexed ingitfile
- inmainrepo $ unannexed ingitfile
+ inmainrepo env $ unannexed ingitfile
-test_copy :: Test
-test_copy = "git-annex copy" ~: TestCase $ intmpclonerepo $ do
+test_copy :: TestEnv -> Test
+test_copy env = "git-annex copy" ~: TestCase $ intmpclonerepo env $ do
annexed_notpresent annexedfile
- inmainrepo $ annexed_present annexedfile
- git_annex "copy" ["--from", "origin", annexedfile] @? "copy --from of file failed"
+ inmainrepo env $ annexed_present annexedfile
+ git_annex env "copy" ["--from", "origin", annexedfile] @? "copy --from of file failed"
annexed_present annexedfile
- inmainrepo $ annexed_present annexedfile
- git_annex "copy" ["--from", "origin", annexedfile] @? "copy --from of file already here failed"
+ inmainrepo env $ annexed_present annexedfile
+ git_annex env "copy" ["--from", "origin", annexedfile] @? "copy --from of file already here failed"
annexed_present annexedfile
- inmainrepo $ annexed_present annexedfile
- git_annex "copy" ["--to", "origin", annexedfile] @? "copy --to of file already there failed"
+ inmainrepo env $ annexed_present annexedfile
+ git_annex env "copy" ["--to", "origin", annexedfile] @? "copy --to of file already there failed"
annexed_present annexedfile
- inmainrepo $ annexed_present annexedfile
- git_annex "move" ["--to", "origin", annexedfile] @? "move --to of file already there failed"
+ inmainrepo env $ annexed_present annexedfile
+ git_annex env "move" ["--to", "origin", annexedfile] @? "move --to of file already there failed"
annexed_notpresent annexedfile
- inmainrepo $ annexed_present annexedfile
+ inmainrepo env $ annexed_present annexedfile
unannexed ingitfile
- inmainrepo $ unannexed ingitfile
- git_annex "copy" ["--to", "origin", ingitfile] @? "copy of ingitfile should be no-op"
+ inmainrepo env $ unannexed ingitfile
+ git_annex env "copy" ["--to", "origin", ingitfile] @? "copy of ingitfile should be no-op"
unannexed ingitfile
- inmainrepo $ unannexed ingitfile
- git_annex "copy" ["--from", "origin", ingitfile] @? "copy of ingitfile should be no-op"
+ inmainrepo env $ unannexed ingitfile
+ git_annex env "copy" ["--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
+test_lock :: TestEnv -> Test
+test_lock env = "git-annex unlock/lock" ~: intmpclonerepo env $ do
-- regression test: unlock of not present file should skip it
annexed_notpresent annexedfile
- not <$> git_annex "unlock" [annexedfile] @? "unlock failed to fail with not present file"
+ not <$> git_annex env "unlock" [annexedfile] @? "unlock failed to fail with not present file"
annexed_notpresent annexedfile
- git_annex "get" [annexedfile] @? "get of file failed"
+ git_annex env "get" [annexedfile] @? "get of file failed"
annexed_present annexedfile
- git_annex "unlock" [annexedfile] @? "unlock failed"
+ git_annex env "unlock" [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" [annexedfile] @? "lock failed"
+ git_annex env "lock" [annexedfile] @? "lock failed"
annexed_present annexedfile
- git_annex "unlock" [annexedfile] @? "unlock failed"
+ git_annex env "unlock" [annexedfile] @? "unlock failed"
unannexed annexedfile
changecontent annexedfile
- git_annex "add" [annexedfile] @? "add of modified file failed"
+ git_annex env "add" [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" [annexedfile]
+ r' <- git_annex env "drop" [annexedfile]
not r' @? "drop wrongly succeeded with no known copy of modified file"
-test_edit :: Test
-test_edit = "git-annex edit/commit" ~: TestList [t False, t True]
- where t precommit = TestCase $ intmpclonerepo $ do
- git_annex "get" [annexedfile] @? "get of file failed"
+test_edit :: TestEnv -> Test
+test_edit env = "git-annex edit/commit" ~: TestList [t False, t True]
+ where t precommit = TestCase $ intmpclonerepo env $ do
+ git_annex env "get" [annexedfile] @? "get of file failed"
annexed_present annexedfile
- git_annex "edit" [annexedfile] @? "edit failed"
+ git_annex env "edit" [annexedfile] @? "edit failed"
unannexed annexedfile
changecontent annexedfile
if precommit
@@ -367,7 +369,7 @@ test_edit = "git-annex edit/commit" ~: TestList [t False, t True]
-- staged, normally git commit does this
boolSystem "git" [Param "add", File annexedfile]
@? "git add of edited file failed"
- git_annex "pre-commit" []
+ git_annex env "pre-commit" []
@? "pre-commit failed"
else do
boolSystem "git" [Params "commit -q -a -m contentchanged"]
@@ -375,21 +377,21 @@ test_edit = "git-annex edit/commit" ~: TestList [t False, t True]
runchecks [checklink, checkunwritable] annexedfile
c <- readFile annexedfile
assertEqual "content of modified file" c (changedcontent annexedfile)
- not <$> git_annex "drop" [annexedfile] @? "drop wrongly succeeded with no known copy of modified file"
+ not <$> git_annex env "drop" [annexedfile] @? "drop wrongly succeeded with no known copy of modified file"
-test_fix :: Test
-test_fix = "git-annex fix" ~: intmpclonerepo $ do
+test_fix :: TestEnv -> Test
+test_fix env = "git-annex fix" ~: intmpclonerepo env $ do
annexed_notpresent annexedfile
- git_annex "fix" [annexedfile] @? "fix of not present failed"
+ git_annex env "fix" [annexedfile] @? "fix of not present failed"
annexed_notpresent annexedfile
- git_annex "get" [annexedfile] @? "get of file failed"
+ git_annex env "get" [annexedfile] @? "get of file failed"
annexed_present annexedfile
- git_annex "fix" [annexedfile] @? "fix of present file failed"
+ git_annex env "fix" [annexedfile] @? "fix of present file failed"
annexed_present annexedfile
createDirectory subdir
boolSystem "git" [Param "mv", File annexedfile, File subdir]
@? "git mv failed"
- git_annex "fix" [newfile] @? "fix of moved file failed"
+ git_annex env "fix" [newfile] @? "fix of moved file failed"
runchecks [checklink, checkunwritable] newfile
c <- readFile newfile
assertEqual "content of moved file" c (content annexedfile)
@@ -397,23 +399,23 @@ test_fix = "git-annex fix" ~: intmpclonerepo $ do
subdir = "s"
newfile = subdir ++ "/" ++ annexedfile
-test_trust :: Test
-test_trust = "git-annex trust/untrust/semitrust/dead" ~: intmpclonerepo $ do
- git_annex "trust" [repo] @? "trust failed"
+test_trust :: TestEnv -> Test
+test_trust env = "git-annex trust/untrust/semitrust/dead" ~: intmpclonerepo env $ do
+ git_annex env "trust" [repo] @? "trust failed"
trustcheck Logs.Trust.Trusted "trusted 1"
- git_annex "trust" [repo] @? "trust of trusted failed"
+ git_annex env "trust" [repo] @? "trust of trusted failed"
trustcheck Logs.Trust.Trusted "trusted 2"
- git_annex "untrust" [repo] @? "untrust failed"
+ git_annex env "untrust" [repo] @? "untrust failed"
trustcheck Logs.Trust.UnTrusted "untrusted 1"
- git_annex "untrust" [repo] @? "untrust of untrusted failed"
+ git_annex env "untrust" [repo] @? "untrust of untrusted failed"
trustcheck Logs.Trust.UnTrusted "untrusted 2"
- git_annex "dead" [repo] @? "dead failed"
+ git_annex env "dead" [repo] @? "dead failed"
trustcheck Logs.Trust.DeadTrusted "deadtrusted 1"
- git_annex "dead" [repo] @? "dead of dead failed"
+ git_annex env "dead" [repo] @? "dead of dead failed"
trustcheck Logs.Trust.DeadTrusted "deadtrusted 2"
- git_annex "semitrust" [repo] @? "semitrust failed"
+ git_annex env "semitrust" [repo] @? "semitrust failed"
trustcheck Logs.Trust.SemiTrusted "semitrusted 1"
- git_annex "semitrust" [repo] @? "semitrust of semitrusted failed"
+ git_annex env "semitrust" [repo] @? "semitrust of semitrusted failed"
trustcheck Logs.Trust.SemiTrusted "semitrusted 2"
where
repo = "origin"
@@ -424,64 +426,64 @@ test_trust = "git-annex trust/untrust/semitrust/dead" ~: intmpclonerepo $ do
return $ u `elem` l
assertBool msg present
-test_fsck :: Test
-test_fsck = "git-annex fsck" ~: TestList [basicfsck, barefsck, withlocaluntrusted, withremoteuntrusted]
+test_fsck :: TestEnv -> Test
+test_fsck env = "git-annex fsck" ~: TestList [basicfsck, barefsck, withlocaluntrusted, withremoteuntrusted]
where
- basicfsck = TestCase $ intmpclonerepo $ do
- git_annex "fsck" [] @? "fsck failed"
+ basicfsck = TestCase $ intmpclonerepo env $ do
+ git_annex env "fsck" [] @? "fsck failed"
boolSystem "git" [Params "config annex.numcopies 2"] @? "git config failed"
fsck_should_fail "numcopies unsatisfied"
boolSystem "git" [Params "config annex.numcopies 1"] @? "git config failed"
corrupt annexedfile
corrupt sha1annexedfile
- barefsck = TestCase $ intmpbareclonerepo $ do
- git_annex "fsck" [] @? "fsck failed"
- withlocaluntrusted = TestCase $ intmpclonerepo $ do
- git_annex "get" [annexedfile] @? "get failed"
- git_annex "untrust" ["origin"] @? "untrust of origin repo failed"
- git_annex "untrust" ["."] @? "untrust of current repo failed"
+ barefsck = TestCase $ intmpbareclonerepo env $ do
+ git_annex env "fsck" [] @? "fsck failed"
+ withlocaluntrusted = TestCase $ intmpclonerepo env $ do
+ git_annex env "get" [annexedfile] @? "get failed"
+ git_annex env "untrust" ["origin"] @? "untrust of origin repo failed"
+ git_annex env "untrust" ["."] @? "untrust of current repo failed"
fsck_should_fail "content only available in untrusted (current) repository"
- git_annex "trust" ["."] @? "trust of current repo failed"
- git_annex "fsck" [annexedfile] @? "fsck failed on file present in trusted repo"
- withremoteuntrusted = TestCase $ intmpclonerepo $ do
+ git_annex env "trust" ["."] @? "trust of current repo failed"
+ git_annex env "fsck" [annexedfile] @? "fsck failed on file present in trusted repo"
+ withremoteuntrusted = TestCase $ intmpclonerepo env $ do
boolSystem "git" [Params "config annex.numcopies 2"] @? "git config failed"
- git_annex "get" [annexedfile] @? "get failed"
- git_annex "get" [sha1annexedfile] @? "get failed"
- git_annex "fsck" [] @? "fsck failed with numcopies=2 and 2 copies"
- git_annex "untrust" ["origin"] @? "untrust of origin failed"
+ git_annex env "get" [annexedfile] @? "get failed"
+ git_annex env "get" [sha1annexedfile] @? "get failed"
+ git_annex env "fsck" [] @? "fsck failed with numcopies=2 and 2 copies"
+ git_annex env "untrust" ["origin"] @? "untrust of origin failed"
fsck_should_fail "content not replicated to enough non-untrusted repositories"
corrupt f = do
- git_annex "get" [f] @? "get of file failed"
+ git_annex env "get" [f] @? "get of file failed"
Utility.FileMode.allowWrite f
writeFile f (changedcontent f)
- not <$> git_annex "fsck" [] @? "fsck failed to fail with corrupted file content"
- git_annex "fsck" [] @? "fsck unexpectedly failed again; previous one did not fix problem with " ++ f
+ not <$> git_annex env "fsck" [] @? "fsck failed to fail with corrupted file content"
+ git_annex env "fsck" [] @? "fsck unexpectedly failed again; previous one did not fix problem with " ++ f
fsck_should_fail m = do
- not <$> git_annex "fsck" [] @? "fsck failed to fail with " ++ m
+ not <$> git_annex env "fsck" [] @? "fsck failed to fail with " ++ m
-test_migrate :: Test
-test_migrate = "git-annex migrate" ~: TestList [t False, t True]
- where t usegitattributes = TestCase $ intmpclonerepo $ do
+test_migrate :: TestEnv -> Test
+test_migrate env = "git-annex migrate" ~: TestList [t False, t True]
+ where t usegitattributes = TestCase $ intmpclonerepo env $ do
annexed_notpresent annexedfile
annexed_notpresent sha1annexedfile
- git_annex "migrate" [annexedfile] @? "migrate of not present failed"
- git_annex "migrate" [sha1annexedfile] @? "migrate of not present failed"
- git_annex "get" [annexedfile] @? "get of file failed"
- git_annex "get" [sha1annexedfile] @? "get of file failed"
+ git_annex env "migrate" [annexedfile] @? "migrate of not present failed"
+ git_annex env "migrate" [sha1annexedfile] @? "migrate of not present failed"
+ git_annex env "get" [annexedfile] @? "get of file failed"
+ git_annex env "get" [sha1annexedfile] @? "get of file failed"
annexed_present annexedfile
annexed_present sha1annexedfile
if usegitattributes
then do
writeFile ".gitattributes" $ "* annex.backend=SHA1"
- git_annex "migrate" [sha1annexedfile]
+ git_annex env "migrate" [sha1annexedfile]
@? "migrate sha1annexedfile failed"
- git_annex "migrate" [annexedfile]
+ git_annex env "migrate" [annexedfile]
@? "migrate annexedfile failed"
else do
- git_annex "migrate" [sha1annexedfile, "--backend", "SHA1"]
+ git_annex env "migrate" [sha1annexedfile, "--backend", "SHA1"]
@? "migrate sha1annexedfile failed"
- git_annex "migrate" [annexedfile, "--backend", "SHA1"]
+ git_annex env "migrate" [annexedfile, "--backend", "SHA1"]
@? "migrate annexedfile failed"
annexed_present annexedfile
annexed_present sha1annexedfile
@@ -490,22 +492,22 @@ test_migrate = "git-annex migrate" ~: TestList [t False, t True]
-- check that reversing a migration works
writeFile ".gitattributes" $ "* annex.backend=SHA256"
- git_annex "migrate" [sha1annexedfile]
+ git_annex env "migrate" [sha1annexedfile]
@? "migrate sha1annexedfile failed"
- git_annex "migrate" [annexedfile]
+ git_annex env "migrate" [annexedfile]
@? "migrate annexedfile failed"
annexed_present annexedfile
annexed_present sha1annexedfile
checkbackend annexedfile backendSHA256
checkbackend sha1annexedfile backendSHA256
-test_unused :: Test
-test_unused = "git-annex unused/dropunused" ~: intmpclonerepo $ do
+test_unused :: TestEnv -> Test
+test_unused env = "git-annex unused/dropunused" ~: intmpclonerepo env $ do
-- keys have to be looked up before files are removed
annexedfilekey <- annexeval $ findkey annexedfile
sha1annexedfilekey <- annexeval $ findkey sha1annexedfile
- git_annex "get" [annexedfile] @? "get of file failed"
- git_annex "get" [sha1annexedfile] @? "get of file failed"
+ git_annex env "get" [annexedfile] @? "get of file failed"
+ git_annex env "get" [sha1annexedfile] @? "get of file failed"
checkunused [] "after get"
boolSystem "git" [Params "rm -q", File annexedfile] @? "git rm failed"
checkunused [] "after rm"
@@ -519,17 +521,17 @@ test_unused = "git-annex unused/dropunused" ~: intmpclonerepo $ do
checkunused [annexedfilekey, sha1annexedfilekey] "after rm sha1annexedfile"
-- good opportunity to test dropkey also
- git_annex "dropkey" ["--force", Types.Key.key2file annexedfilekey]
+ git_annex env "dropkey" ["--force", Types.Key.key2file annexedfilekey]
@? "dropkey failed"
checkunused [sha1annexedfilekey] ("after dropkey --force " ++ Types.Key.key2file annexedfilekey)
- git_annex "dropunused" ["1", "2"] @? "dropunused failed"
+ git_annex env "dropunused" ["1", "2"] @? "dropunused failed"
checkunused [] "after dropunused"
- git_annex "dropunused" ["10", "501"] @? "dropunused failed on bogus numbers"
+ git_annex env "dropunused" ["10", "501"] @? "dropunused failed on bogus numbers"
where
checkunused expectedkeys desc = do
- git_annex "unused" [] @? "unused failed"
+ git_annex env "unused" [] @? "unused failed"
unusedmap <- annexeval $ Logs.Unused.readUnusedLog ""
let unusedkeys = M.elems unusedmap
assertEqual ("unused keys differ " ++ desc)
@@ -538,119 +540,119 @@ test_unused = "git-annex unused/dropunused" ~: intmpclonerepo $ do
r <- Backend.lookupFile f
return $ fst $ fromJust r
-test_describe :: Test
-test_describe = "git-annex describe" ~: intmpclonerepo $ do
- git_annex "describe" [".", "this repo"] @? "describe 1 failed"
- git_annex "describe" ["origin", "origin repo"] @? "describe 2 failed"
+test_describe :: TestEnv -> Test
+test_describe env = "git-annex describe" ~: intmpclonerepo env $ do
+ git_annex env "describe" [".", "this repo"] @? "describe 1 failed"
+ git_annex env "describe" ["origin", "origin repo"] @? "describe 2 failed"
-test_find :: Test
-test_find = "git-annex find" ~: intmpclonerepo $ do
+test_find :: TestEnv -> Test
+test_find env = "git-annex find" ~: intmpclonerepo env $ do
annexed_notpresent annexedfile
- git_annex_expectoutput "find" [] []
- git_annex "get" [annexedfile] @? "get failed"
+ git_annex_expectoutput env "find" [] []
+ git_annex env "get" [annexedfile] @? "get failed"
annexed_present annexedfile
annexed_notpresent sha1annexedfile
- git_annex_expectoutput "find" [] [annexedfile]
- git_annex_expectoutput "find" ["--exclude", annexedfile, "--and", "--exclude", sha1annexedfile] []
- git_annex_expectoutput "find" ["--include", annexedfile] [annexedfile]
- git_annex_expectoutput "find" ["--not", "--in", "origin"] []
- git_annex_expectoutput "find" ["--copies", "1", "--and", "--not", "--copies", "2"] [sha1annexedfile]
- git_annex_expectoutput "find" ["--inbackend", "SHA1"] [sha1annexedfile]
- git_annex_expectoutput "find" ["--inbackend", "WORM"] []
+ git_annex_expectoutput env "find" [] [annexedfile]
+ git_annex_expectoutput env "find" ["--exclude", annexedfile, "--and", "--exclude", sha1annexedfile] []
+ git_annex_expectoutput env "find" ["--include", annexedfile] [annexedfile]
+ git_annex_expectoutput env "find" ["--not", "--in", "origin"] []
+ git_annex_expectoutput env "find" ["--copies", "1", "--and", "--not", "--copies", "2"] [sha1annexedfile]
+ git_annex_expectoutput env "find" ["--inbackend", "SHA1"] [sha1annexedfile]
+ git_annex_expectoutput env "find" ["--inbackend", "WORM"] []
{- --include=* should match files in subdirectories too,
- and --exclude=* should exclude them. -}
createDirectory "dir"
writeFile "dir/subfile" "subfile"
- git_annex "add" ["dir"] @? "add of subdir failed"
- git_annex_expectoutput "find" ["--include", "*", "--exclude", annexedfile, "--exclude", sha1annexedfile] ["dir/subfile"]
- git_annex_expectoutput "find" ["--exclude", "*"] []
+ git_annex env "add" ["dir"] @? "add of subdir failed"
+ git_annex_expectoutput env "find" ["--include", "*", "--exclude", annexedfile, "--exclude", sha1annexedfile] ["dir/subfile"]
+ git_annex_expectoutput env "find" ["--exclude", "*"] []
-test_merge :: Test
-test_merge = "git-annex merge" ~: intmpclonerepo $ do
- git_annex "merge" [] @? "merge failed"
+test_merge :: TestEnv -> Test
+test_merge env = "git-annex merge" ~: intmpclonerepo env $ do
+ git_annex env "merge" [] @? "merge failed"
-test_status :: Test
-test_status = "git-annex status" ~: intmpclonerepo $ do
- json <- git_annex_output "status" ["--json"]
+test_status :: TestEnv -> Test
+test_status env = "git-annex status" ~: intmpclonerepo env $ do
+ json <- git_annex_output env "status" ["--json"]
case Text.JSON.decodeStrict json :: Text.JSON.Result (Text.JSON.JSObject Text.JSON.JSValue) of
Text.JSON.Ok _ -> return ()
Text.JSON.Error e -> assertFailure e
-test_version :: Test
-test_version = "git-annex version" ~: intmpclonerepo $ do
- git_annex "version" [] @? "version failed"
+test_version :: TestEnv -> Test
+test_version env = "git-annex version" ~: intmpclonerepo env $ do
+ git_annex env "version" [] @? "version failed"
-test_sync :: Test
-test_sync = "git-annex sync" ~: intmpclonerepo $ do
- git_annex "sync" [] @? "sync failed"
+test_sync :: TestEnv -> Test
+test_sync env = "git-annex sync" ~: intmpclonerepo env $ do
+ git_annex env "sync" [] @? "sync failed"
{- Regression test for sync merge bug fixed in
- 0214e0fb175a608a49b812d81b4632c081f63027 -}
-test_sync_regression :: Test
-test_sync_regression = "git-annex sync_regression" ~:
+test_sync_regression :: TestEnv -> Test
+test_sync_regression env = "git-annex sync_regression" ~:
{- We need 3 repos to see this bug. -}
- withtmpclonerepo False $ \r1 -> do
- withtmpclonerepo False $ \r2 -> do
- withtmpclonerepo False $ \r3 -> do
- forM_ [r1, r2, r3] $ \r -> indir r $ do
+ withtmpclonerepo env False $ \r1 -> do
+ withtmpclonerepo env False $ \r2 -> do
+ withtmpclonerepo env False $ \r3 -> do
+ forM_ [r1, r2, r3] $ \r -> indir env r $ do
when (r /= r1) $
boolSystem "git" [Params "remote add r1", File ("../../" ++ r1)] @? "remote add"
when (r /= r2) $
boolSystem "git" [Params "remote add r2", File ("../../" ++ r2)] @? "remote add"
when (r /= r3) $
boolSystem "git" [Params "remote add r3", File ("../../" ++ r3)] @? "remote add"
- git_annex "get" [annexedfile] @? "get failed"
+ git_annex env "get" [annexedfile] @? "get failed"
boolSystem "git" [Params "remote rm origin"] @? "remote rm"
- forM_ [r3, r2, r1] $ \r -> indir r $
- git_annex "sync" [] @? "sync failed"
- forM_ [r3, r2] $ \r -> indir r $
- git_annex "drop" ["--force", annexedfile] @? "drop failed"
- indir r1 $ do
- git_annex "sync" [] @? "sync failed in r1"
- git_annex_expectoutput "find" ["--in", "r3"] []
+ forM_ [r3, r2, r1] $ \r -> indir env r $
+ git_annex env "sync" [] @? "sync failed"
+ forM_ [r3, r2] $ \r -> indir env r $
+ git_annex env "drop" ["--force", annexedfile] @? "drop failed"
+ indir env r1 $ do
+ git_annex env "sync" [] @? "sync failed in r1"
+ git_annex_expectoutput env "find" ["--in", "r3"] []
{- This was the bug. The sync
- mangled location log data and it
- thought the file was still in r2 -}
- git_annex_expectoutput "find" ["--in", "r2"] []
+ git_annex_expectoutput env "find" ["--in", "r2"] []
-test_map :: Test
-test_map = "git-annex map" ~: intmpclonerepo $ do
+test_map :: TestEnv -> Test
+test_map env = "git-annex map" ~: intmpclonerepo env $ do
-- set descriptions, that will be looked for in the map
- git_annex "describe" [".", "this repo"] @? "describe 1 failed"
- git_annex "describe" ["origin", "origin repo"] @? "describe 2 failed"
+ git_annex env "describe" [".", "this repo"] @? "describe 1 failed"
+ git_annex env "describe" ["origin", "origin repo"] @? "describe 2 failed"
-- --fast avoids it running graphviz, not a build dependency
- git_annex "map" ["--fast"] @? "map failed"
+ git_annex env "map" ["--fast"] @? "map failed"
-test_uninit :: Test
-test_uninit = "git-annex uninit" ~: intmpclonerepo $ do
- git_annex "get" [] @? "get failed"
+test_uninit :: TestEnv -> Test
+test_uninit env = "git-annex uninit" ~: intmpclonerepo env $ do
+ git_annex env "get" [] @? "get failed"
annexed_present annexedfile
boolSystem "git" [Params "checkout git-annex"] @? "git checkout git-annex"
- not <$> git_annex "uninit" [] @? "uninit failed to fail when git-annex branch was checked out"
+ not <$> git_annex env "uninit" [] @? "uninit failed to fail when git-annex branch was checked out"
boolSystem "git" [Params "checkout master"] @? "git checkout master"
- _ <- git_annex "uninit" [] -- exit status not checked; does abnormal exit
+ _ <- git_annex env "uninit" [] -- exit status not checked; does abnormal exit
checkregularfile annexedfile
doesDirectoryExist ".git" @? ".git vanished in uninit"
not <$> doesDirectoryExist ".git/annex" @? ".git/annex still present after uninit"
-test_upgrade :: Test
-test_upgrade = "git-annex upgrade" ~: intmpclonerepo $ do
- git_annex "upgrade" [] @? "upgrade from same version failed"
+test_upgrade :: TestEnv -> Test
+test_upgrade env = "git-annex upgrade" ~: intmpclonerepo env $ do
+ git_annex env "upgrade" [] @? "upgrade from same version failed"
-test_whereis :: Test
-test_whereis = "git-annex whereis" ~: intmpclonerepo $ do
+test_whereis :: TestEnv -> Test
+test_whereis env = "git-annex whereis" ~: intmpclonerepo env $ do
annexed_notpresent annexedfile
- git_annex "whereis" [annexedfile] @? "whereis on non-present file failed"
- git_annex "untrust" ["origin"] @? "untrust failed"
- not <$> git_annex "whereis" [annexedfile] @? "whereis on non-present file only present in untrusted repo failed to fail"
- git_annex "get" [annexedfile] @? "get failed"
+ git_annex env "whereis" [annexedfile] @? "whereis on non-present file failed"
+ git_annex env "untrust" ["origin"] @? "untrust failed"
+ not <$> git_annex env "whereis" [annexedfile] @? "whereis on non-present file only present in untrusted repo failed to fail"
+ git_annex env "get" [annexedfile] @? "get failed"
annexed_present annexedfile
- git_annex "whereis" [annexedfile] @? "whereis on present file failed"
+ git_annex env "whereis" [annexedfile] @? "whereis on present file failed"
-test_hook_remote :: Test
-test_hook_remote = "git-annex hook remote" ~: intmpclonerepo $ do
- git_annex "initremote" (words "foo type=hook encryption=none hooktype=foo") @? "initremote failed"
+test_hook_remote :: TestEnv -> Test
+test_hook_remote env = "git-annex hook remote" ~: intmpclonerepo env $ do
+ git_annex env "initremote" (words "foo type=hook encryption=none hooktype=foo") @? "initremote failed"
createDirectory dir
git_config "annex.foo-store-hook" $
"cp $ANNEX_FILE " ++ loc
@@ -660,15 +662,15 @@ test_hook_remote = "git-annex hook remote" ~: intmpclonerepo $ do
"rm -f " ++ loc
git_config "annex.foo-checkpresent-hook" $
"if [ -e " ++ loc ++ " ]; then echo $ANNEX_KEY; fi"
- git_annex "get" [annexedfile] @? "get of file failed"
+ git_annex env "get" [annexedfile] @? "get of file failed"
annexed_present annexedfile
- git_annex "copy" [annexedfile, "--to", "foo"] @? "copy --to hook remote failed"
+ git_annex env "copy" [annexedfile, "--to", "foo"] @? "copy --to hook remote failed"
annexed_present annexedfile
- git_annex "drop" [annexedfile, "--numcopies=2"] @? "drop failed"
+ git_annex env "drop" [annexedfile, "--numcopies=2"] @? "drop failed"
annexed_notpresent annexedfile
- git_annex "move" [annexedfile, "--from", "foo"] @? "move --from hook remote failed"
+ git_annex env "move" [annexedfile, "--from", "foo"] @? "move --from hook remote failed"
annexed_present annexedfile
- not <$> git_annex "drop" [annexedfile, "--numcopies=2"] @? "drop failed to fail"
+ not <$> git_annex env "drop" [annexedfile, "--numcopies=2"] @? "drop failed to fail"
annexed_present annexedfile
where
dir = "dir"
@@ -676,61 +678,59 @@ test_hook_remote = "git-annex hook remote" ~: intmpclonerepo $ do
git_config k v = boolSystem "git" [Param "config", Param k, Param v]
@? "git config failed"
-test_directory_remote :: Test
-test_directory_remote = "git-annex directory remote" ~: intmpclonerepo $ do
+test_directory_remote :: TestEnv -> Test
+test_directory_remote env = "git-annex directory remote" ~: intmpclonerepo env $ do
createDirectory "dir"
- git_annex "initremote" (words $ "foo type=directory encryption=none directory=dir") @? "initremote failed"
- git_annex "get" [annexedfile] @? "get of file failed"
+ git_annex env "initremote" (words $ "foo type=directory encryption=none directory=dir") @? "initremote failed"
+ git_annex env "get" [annexedfile] @? "get of file failed"
annexed_present annexedfile
- git_annex "copy" [annexedfile, "--to", "foo"] @? "copy --to directory remote failed"
+ git_annex env "copy" [annexedfile, "--to", "foo"] @? "copy --to directory remote failed"
annexed_present annexedfile
- git_annex "drop" [annexedfile, "--numcopies=2"] @? "drop failed"
+ git_annex env "drop" [annexedfile, "--numcopies=2"] @? "drop failed"
annexed_notpresent annexedfile
- git_annex "move" [annexedfile, "--from", "foo"] @? "move --from directory remote failed"
+ git_annex env "move" [annexedfile, "--from", "foo"] @? "move --from directory remote failed"
annexed_present annexedfile
- not <$> git_annex "drop" [annexedfile, "--numcopies=2"] @? "drop failed to fail"
+ not <$> git_annex env "drop" [annexedfile, "--numcopies=2"] @? "drop failed to fail"
annexed_present annexedfile
-test_rsync_remote :: Test
-test_rsync_remote = "git-annex rsync remote" ~: intmpclonerepo $ do
+test_rsync_remote :: TestEnv -> Test
+test_rsync_remote env = "git-annex rsync remote" ~: intmpclonerepo env $ do
createDirectory "dir"
- git_annex "initremote" (words $ "foo type=rsync encryption=none rsyncurl=dir") @? "initremote failed"
- git_annex "get" [annexedfile] @? "get of file failed"
+ git_annex env "initremote" (words $ "foo type=rsync encryption=none rsyncurl=dir") @? "initremote failed"
+ git_annex env "get" [annexedfile] @? "get of file failed"
annexed_present annexedfile
- git_annex "copy" [annexedfile, "--to", "foo"] @? "copy --to rsync remote failed"
+ git_annex env "copy" [annexedfile, "--to", "foo"] @? "copy --to rsync remote failed"
annexed_present annexedfile
- git_annex "drop" [annexedfile, "--numcopies=2"] @? "drop failed"
+ git_annex env "drop" [annexedfile, "--numcopies=2"] @? "drop failed"
annexed_notpresent annexedfile
- git_annex "move" [annexedfile, "--from", "foo"] @? "move --from rsync remote failed"
+ git_annex env "move" [annexedfile, "--from", "foo"] @? "move --from rsync remote failed"
annexed_present annexedfile
- not <$> git_annex "drop" [annexedfile, "--numcopies=2"] @? "drop failed to fail"
+ not <$> git_annex env "drop" [annexedfile, "--numcopies=2"] @? "drop failed to fail"
annexed_present annexedfile
-test_bup_remote :: Test
-test_bup_remote = "git-annex bup remote" ~: intmpclonerepo $ when Build.SysConfig.bup $ do
+test_bup_remote :: TestEnv -> Test
+test_bup_remote env = "git-annex bup remote" ~: intmpclonerepo env $ when Build.SysConfig.bup $ do
dir <- absPath "dir" -- bup special remote needs an absolute path
createDirectory dir
- git_annex "initremote" (words $ "foo type=bup encryption=none buprepo="++dir) @? "initremote failed"
- git_annex "get" [annexedfile] @? "get of file failed"
+ git_annex env "initremote" (words $ "foo type=bup encryption=none buprepo="++dir) @? "initremote failed"
+ git_annex env "get" [annexedfile] @? "get of file failed"
annexed_present annexedfile
- git_annex "copy" [annexedfile, "--to", "foo"] @? "copy --to bup remote failed"
+ git_annex env "copy" [annexedfile, "--to", "foo"] @? "copy --to bup remote failed"
annexed_present annexedfile
- git_annex "drop" [annexedfile, "--numcopies=2"] @? "drop failed"
+ git_annex env "drop" [annexedfile, "--numcopies=2"] @? "drop failed"
annexed_notpresent annexedfile
- git_annex "copy" [annexedfile, "--from", "foo"] @? "copy --from bup remote failed"
+ git_annex env "copy" [annexedfile, "--from", "foo"] @? "copy --from bup remote failed"
annexed_present annexedfile
- not <$> git_annex "move" [annexedfile, "--from", "foo"] @? "move --from bup remote failed to fail"
+ not <$> git_annex env "move" [annexedfile, "--from", "foo"] @? "move --from bup remote failed to fail"
annexed_present annexedfile
-- gpg is not a build dependency, so only test when it's available
-test_crypto :: Test
-test_crypto = "git-annex crypto" ~: intmpclonerepo $ when Build.SysConfig.gpg $ do
- -- force gpg into batch mode for the tests
- void $ Utility.Env.setEnv "GPG_BATCH" "1" True
+test_crypto :: TestEnv -> Test
+test_crypto env = "git-annex crypto" ~: intmpclonerepo env $ when Build.SysConfig.gpg $ do
Utility.Gpg.testTestHarness @? "test harness self-test failed"
Utility.Gpg.testHarness $ do
createDirectory "dir"
- let a cmd = git_annex cmd
+ let a cmd = git_annex env cmd
[ "foo"
, "type=directory"
, "encryption=" ++ Utility.Gpg.testKeyId
@@ -741,21 +741,24 @@ test_crypto = "git-annex crypto" ~: intmpclonerepo $ when Build.SysConfig.gpg $
not <$> a "initremote" @? "initremote failed to fail when run twice in a row"
a "enableremote" @? "enableremote failed"
a "enableremote" @? "enableremote failed when run twice in a row"
- git_annex "get" [annexedfile] @? "get of file failed"
+ git_annex env "get" [annexedfile] @? "get of file failed"
annexed_present annexedfile
- git_annex "copy" [annexedfile, "--to", "foo"] @? "copy --to encrypted remote failed"
+ git_annex env "copy" [annexedfile, "--to", "foo"] @? "copy --to encrypted remote failed"
annexed_present annexedfile
- git_annex "drop" [annexedfile, "--numcopies=2"] @? "drop failed"
+ git_annex env "drop" [annexedfile, "--numcopies=2"] @? "drop failed"
annexed_notpresent annexedfile
- git_annex "move" [annexedfile, "--from", "foo"] @? "move --from encrypted remote failed"
+ git_annex env "move" [annexedfile, "--from", "foo"] @? "move --from encrypted remote failed"
annexed_present annexedfile
- not <$> git_annex "drop" [annexedfile, "--numcopies=2"] @? "drop failed to fail"
+ not <$> git_annex env "drop" [annexedfile, "--numcopies=2"] @? "drop failed to fail"
annexed_present annexedfile
-- This is equivilant to running git-annex, but it's all run in-process
-- so test coverage collection works.
-git_annex :: String -> [String] -> IO Bool
-git_annex command params = do
+git_annex :: TestEnv -> String -> [String] -> IO Bool
+git_annex env command params = do
+ forM_ (M.toList env) $ \(var, val) ->
+ Utility.Env.setEnv var val True
+
-- catch all errors, including normally fatal errors
r <- try (run)::IO (Either SomeException ())
case r of
@@ -765,18 +768,19 @@ git_annex command params = do
run = GitAnnex.run (command:"-q":params)
{- Runs git-annex and returns its output. -}
-git_annex_output :: String -> [String] -> IO String
-git_annex_output command params = do
- got <- Utility.Process.readProcess "git-annex" (command:params)
+git_annex_output :: TestEnv -> String -> [String] -> IO String
+git_annex_output env command params = do
+ got <- Utility.Process.readProcessEnv "git-annex" (command:params) $
+ Just $ M.toList env
-- XXX since the above is a separate process, code coverage stats are
-- not gathered for things run in it.
-- Run same command again, to get code coverage.
- _ <- git_annex command params
+ _ <- git_annex env command params
return got
-git_annex_expectoutput :: String -> [String] -> [String] -> IO ()
-git_annex_expectoutput command params expected = do
- got <- lines <$> git_annex_output command params
+git_annex_expectoutput :: TestEnv -> String -> [String] -> [String] -> IO ()
+git_annex_expectoutput env command params expected = do
+ got <- lines <$> git_annex_output env command params
got == expected @? ("unexpected value running " ++ command ++ " " ++ show params ++ " -- got: " ++ show got ++ " expected: " ++ show expected)
-- Runs an action in the current annex. Note that shutdown actions
@@ -788,56 +792,57 @@ annexeval a = do
Annex.setOutput Types.Messages.QuietOutput
a
-innewrepo :: Assertion -> Assertion
-innewrepo a = withgitrepo $ \r -> indir r a
+innewrepo :: TestEnv -> Assertion -> Assertion
+innewrepo env a = withgitrepo env $ \r -> indir env r a
-inmainrepo :: Assertion -> Assertion
-inmainrepo a = indir mainrepodir a
+inmainrepo :: TestEnv -> Assertion -> Assertion
+inmainrepo env a = indir env mainrepodir a
-intmpclonerepo :: Assertion -> Assertion
-intmpclonerepo a = withtmpclonerepo False $ \r -> indir r a
+intmpclonerepo :: TestEnv -> Assertion -> Assertion
+intmpclonerepo env a = withtmpclonerepo env False $ \r -> indir env r a
-intmpbareclonerepo :: Assertion -> Assertion
-intmpbareclonerepo a = withtmpclonerepo True $ \r -> indir r a
+intmpbareclonerepo :: TestEnv -> Assertion -> Assertion
+intmpbareclonerepo env a = withtmpclonerepo env True $ \r -> indir env r a
-withtmpclonerepo :: Bool -> (FilePath -> Assertion) -> Assertion
-withtmpclonerepo bare a = do
+withtmpclonerepo :: TestEnv -> Bool -> (FilePath -> Assertion) -> Assertion
+withtmpclonerepo env bare a = do
dir <- tmprepodir
- bracket (clonerepo mainrepodir dir bare) cleanup a
+ bracket (clonerepo env mainrepodir dir bare) cleanup a
-withgitrepo :: (FilePath -> Assertion) -> Assertion
-withgitrepo = bracket (setuprepo mainrepodir) return
+withgitrepo :: TestEnv -> (FilePath -> Assertion) -> Assertion
+withgitrepo env = bracket (setuprepo env mainrepodir) return
-indir :: FilePath -> Assertion -> Assertion
-indir dir a = do
+indir :: TestEnv -> FilePath -> Assertion -> Assertion
+indir env dir a = do
cwd <- getCurrentDirectory
-- Assertion failures throw non-IO errors; catch
-- any type of error and change back to cwd before
-- rethrowing.
- r <- bracket_ (changeToTmpDir dir) (setCurrentDirectory cwd)
+ r <- bracket_ (changeToTmpDir env dir) (setCurrentDirectory cwd)
(try (a)::IO (Either SomeException ()))
case r of
Right () -> return ()
Left e -> throw e
-setuprepo :: FilePath -> IO FilePath
-setuprepo dir = do
+setuprepo :: TestEnv -> FilePath -> IO FilePath
+setuprepo env dir = do
cleanup dir
ensuretmpdir
boolSystem "git" [Params "init -q", File dir] @? "git init failed"
- indir dir $ do
+ indir env dir $ do
boolSystem "git" [Params "config user.name", Param "Test User"] @? "git config failed"
boolSystem "git" [Params "config user.email test@example.com"] @? "git config failed"
return dir
-- clones are always done as local clones; we cannot test ssh clones
-clonerepo :: FilePath -> FilePath -> Bool -> IO FilePath
-clonerepo old new bare = do
+clonerepo :: TestEnv -> FilePath -> FilePath -> Bool -> IO FilePath
+clonerepo env old new bare = do
cleanup new
ensuretmpdir
let b = if bare then " --bare" else ""
boolSystem "git" [Params ("clone -q" ++ b), File old, File new] @? "git clone failed"
- indir new $ git_annex "init" ["-q", new] @? "git annex init failed"
+ indir env new $
+ git_annex env "init" ["-q", new] @? "git annex init failed"
return new
ensuretmpdir :: IO ()
@@ -938,29 +943,34 @@ annexed_present = runchecks
unannexed :: FilePath -> Assertion
unannexed = runchecks [checkregularfile, checkcontent, checkwritable]
-prepare :: IO ()
+prepare :: IO TestEnv
prepare = do
whenM (doesDirectoryExist tmpdir) $
error $ "The temporary directory " ++ tmpdir ++ " already exists; cannot run test suite."
- -- While PATH is mostly avoided, the commit hook does run it,
- -- and so does git_annex_output. Make sure that the just-built
- -- git annex is used.
cwd <- getCurrentDirectory
- p <- Utility.Env.getEnvDefault "PATH" ""
- void $ Utility.Env.setEnv "PATH" (cwd ++ ":" ++ p) True
- void $ Utility.Env.setEnv "TOPDIR" cwd True
- -- Avoid git complaining if it cannot determine the user's email
- -- address, or exploding if it doesn't know the user's name.
- void $ Utility.Env.setEnv "GIT_AUTHOR_EMAIL" "test@example.com" True
- void $ Utility.Env.setEnv "GIT_AUTHOR_NAME" "git-annex test" True
- void $ Utility.Env.setEnv "GIT_COMMITTER_EMAIL" "test@example.com" True
- void $ Utility.Env.setEnv "GIT_COMMITTER_NAME" "git-annex test" True
-
-changeToTmpDir :: FilePath -> IO ()
-changeToTmpDir t = do
- -- Hack alert. Threading state to here was too much bother.
- topdir <- Utility.Env.getEnvDefault "TOPDIR" ""
+ p <- Utility.Env.getEnvDefault "PATH" ""
+
+ let env =
+ -- Ensure that the just-built git annex is used.
+ [ ("PATH", cwd ++ ":" ++ p)
+ , ("TOPDIR", cwd)
+ -- Avoid git complaining if it cannot determine the user's
+ -- email address, or exploding if it doesn't know the user's
+ -- name.
+ , ("GIT_AUTHOR_EMAIL", "test@example.com")
+ , ("GIT_AUTHOR_NAME", "git-annex test")
+ , ("GIT_COMMITTER_EMAIL", "test@example.com")
+ , ("GIT_COMMITTER_NAME", "git-annex test")
+ -- force gpg into batch mode for the tests
+ , ("GPG_BATCH", "1")
+ ]
+
+ return $ M.fromList env
+
+changeToTmpDir :: TestEnv -> FilePath -> IO ()
+changeToTmpDir env t = do
+ let topdir = fromMaybe "" $ M.lookup "TOPDIR" env
setCurrentDirectory $ topdir ++ "/" ++ t
tmpdir :: String