summaryrefslogtreecommitdiff
path: root/Test.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2013-11-14 17:03:49 -0400
committerGravatar Joey Hess <joey@kitenet.net>2013-11-14 17:03:49 -0400
commitf4b4f327b69189d24663a7db6407c1f7a6e48fdd (patch)
tree37966d3af76c14dfdfe8361e84d5c3d2e3c953f9 /Test.hs
parent0951342092a78c734298f519ef253d7283d630f2 (diff)
finished converting test suite for tasty
Also merged in Test.hs from master.
Diffstat (limited to 'Test.hs')
-rw-r--r--Test.hs634
1 files changed, 393 insertions, 241 deletions
diff --git a/Test.hs b/Test.hs
index ce1863bd7..8cfe3c301 100644
--- a/Test.hs
+++ b/Test.hs
@@ -36,6 +36,7 @@ import qualified Types.KeySource
import qualified Types.Backend
import qualified Types.TrustLevel
import qualified Types
+import qualified Logs
import qualified Logs.UUIDBased
import qualified Logs.Trust
import qualified Logs.Remote
@@ -58,11 +59,16 @@ import qualified Utility.Process
import qualified Utility.Misc
import qualified Utility.InodeCache
import qualified Utility.Env
-import qualified Utility.Gpg
import qualified Utility.Matcher
import qualified Utility.Exception
+import qualified Utility.Hash
+import qualified Utility.Scheduled
+import qualified Utility.HumanTime
#ifndef mingw32_HOST_OS
import qualified GitAnnex
+import qualified Remote.Helper.Encryptable
+import qualified Types.Crypto
+import qualified Utility.Gpg
#endif
type TestEnv = M.Map String String
@@ -91,8 +97,10 @@ properties = testGroup "QuickCheck"
, testProperty "prop_idempotent_deencode" Utility.Format.prop_idempotent_deencode
, testProperty "prop_idempotent_fileKey" Locations.prop_idempotent_fileKey
, testProperty "prop_idempotent_key_encode" Types.Key.prop_idempotent_key_encode
+ , testProperty "prop_idempotent_key_decode" Types.Key.prop_idempotent_key_decode
, testProperty "prop_idempotent_shellEscape" Utility.SafeCommand.prop_idempotent_shellEscape
, testProperty "prop_idempotent_shellEscape_multiword" Utility.SafeCommand.prop_idempotent_shellEscape_multiword
+ , testProperty "prop_logs_sane" Logs.prop_logs_sane
, testProperty "prop_idempotent_configEscape" Logs.Remote.prop_idempotent_configEscape
, testProperty "prop_parse_show_Config" Logs.Remote.prop_parse_show_Config
, testProperty "prop_parentDir_basics" Utility.Path.prop_parentDir_basics
@@ -110,6 +118,9 @@ properties = testGroup "QuickCheck"
, testProperty "prop_parse_show_log" Logs.Presence.prop_parse_show_log
, testProperty "prop_read_show_TrustLevel" Types.TrustLevel.prop_read_show_TrustLevel
, testProperty "prop_parse_show_TrustLog" Logs.Trust.prop_parse_show_TrustLog
+ , testProperty "prop_hashes_stable" Utility.Hash.prop_hashes_stable
+ , testProperty "prop_schedule_roundtrips" Utility.Scheduled.prop_schedule_roundtrips
+ , testProperty "prop_duration_roundtrips" Utility.HumanTime.prop_duration_roundtrips
]
unitTests :: TestEnv -> String -> TestTree
@@ -119,30 +130,39 @@ unitTests env note = testGroup ("Unit Tests " ++ note)
, check "add" test_add
, check "add sha1dup" test_add_sha1dup
, check "add subdirs" test_add_subdirs
- {-
, check "reinject" test_reinject
- , check "unannex" test_unannex
- , check "drop" test_drop
+ , check "unannex (no copy)" test_unannex_nocopy
+ , check "unannex (with copy)" test_unannex_withcopy
+ , check "drop (no remote)" test_drop_noremote
+ , check "drop (with remote)" test_drop_withremote
+ , check "drop (untrusted remote)" test_drop_untrustedremote
, check "get" test_get
, check "move" test_move
, check "copy" test_copy
, check "lock" test_lock
- , check "edit" test_edit
+ , check "edit (no pre-commit)" test_edit
+ , check "edit (pre-commit)" test_edit_precommit
, check "fix" test_fix
, check "trust" test_trust
- , check "fsck" test_fsck
+ , check "fsck (basics)" test_fsck_basic
+ , check "fsck (bare)" test_fsck_bare
+ , check "fsck (local untrusted)" test_fsck_localuntrusted
+ , check "fsck (remote untrusted)" test_fsck_remoteuntrusted
, check "migrate" test_migrate
+ , check "migrate (via gitattributes)" test_migrate_via_gitattributes
, check" unused" test_unused
, check "describe" test_describe
, check "find" test_find
, check "merge" test_merge
- , check "status" test_status
+ , check "info" test_info
, check "version" test_version
, check "sync" test_sync
, check "union merge regression" test_union_merge_regression
, check "conflict resolution" test_conflict_resolution
+ , check "conflict_resolution (mixed directory and file)" test_mixed_conflict_resolution
, check "map" test_map
, check "uninit" test_uninit
+ , check "uninit (in git-annex branch)" test_uninit_inbranch
, check "upgrade" test_upgrade
, check "whereis" test_whereis
, check "hook remote" test_hook_remote
@@ -151,7 +171,6 @@ unitTests env note = testGroup ("Unit Tests " ++ note)
, check "bup remote" test_bup_remote
, check "crypto" test_crypto
, check "preferred content" test_preferred_content
- -}
, check "global cleanup" test_global_cleanup
]
where
@@ -182,12 +201,21 @@ test_add env = inmainrepo env $ do
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 -m commit"] @? "git commit failed"
- git_annex env "add" [ingitfile] @? "add ingitfile should be no-op"
- unannexed ingitfile
+ ifM (annexeval Config.isDirect)
+ ( do
+ boolSystem "rm" [Params "-f", File wormannexedfile] @? "rm failed"
+ writeFile ingitfile $ content ingitfile
+ not <$> boolSystem "git" [Param "add", File ingitfile] @? "git add failed to fail in direct mode"
+ boolSystem "rm" [Params "-f", File ingitfile] @? "rm failed"
+ git_annex env "sync" [] @? "sync failed"
+ , do
+ 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 -m commit"] @? "git commit failed"
+ git_annex env "add" [ingitfile] @? "add ingitfile should be no-op"
+ unannexed ingitfile
+ )
test_add_sha1dup :: TestEnv -> Assertion
test_add_sha1dup env = intmpclonerepo env $ do
@@ -209,8 +237,8 @@ test_add_subdirs env = intmpclonerepo env $ do
git_annex env "add" [".." </> "dir2"] @? "add of ../subdir failed"
#endif
-test_reinject :: TestEnv -> Test
-test_reinject env = "git-annex reinject/fromkey" ~: TestCase $ intmpclonerepoInDirect env $ do
+test_reinject :: TestEnv -> Assertion
+test_reinject env = intmpclonerepoInDirect env $ do
git_annex env "drop" ["--force", sha1annexedfile] @? "drop failed"
writeFile tmp $ content sha1annexedfile
r <- annexeval $ Types.Backend.getKey backendSHA1 $
@@ -222,53 +250,57 @@ test_reinject env = "git-annex reinject/fromkey" ~: TestCase $ intmpclonerepoInD
where
tmp = "tmpfile"
-test_unannex :: TestEnv -> Test
-test_unannex env = "git-annex unannex" ~: TestList [nocopy, withcopy]
- where
- nocopy = "no content" ~: intmpclonerepo env $ do
- annexed_notpresent annexedfile
- git_annex env "unannex" [annexedfile] @? "unannex failed with no copy"
- annexed_notpresent annexedfile
- withcopy = "with content" ~: intmpclonerepo env $ do
- git_annex env "get" [annexedfile] @? "get failed"
- annexed_present annexedfile
- git_annex env "unannex" [annexedfile, sha1annexedfile] @? "unannex failed"
- unannexed annexedfile
- git_annex env "unannex" [annexedfile] @? "unannex failed on non-annexed file"
- unannexed annexedfile
+test_unannex_nocopy :: TestEnv -> Assertion
+test_unannex_nocopy env = intmpclonerepo env $ do
+ annexed_notpresent annexedfile
+ git_annex env "unannex" [annexedfile] @? "unannex failed with no copy"
+ annexed_notpresent annexedfile
+
+test_unannex_withcopy :: TestEnv -> Assertion
+test_unannex_withcopy env = intmpclonerepo env $ do
+ git_annex env "get" [annexedfile] @? "get failed"
+ annexed_present annexedfile
+ git_annex env "unannex" [annexedfile, sha1annexedfile] @? "unannex failed"
+ unannexed annexedfile
+ git_annex env "unannex" [annexedfile] @? "unannex failed on non-annexed file"
+ unannexed annexedfile
+ unlessM (annexeval Config.isDirect) $ do
git_annex env "unannex" [ingitfile] @? "unannex ingitfile should be no-op"
unannexed ingitfile
-test_drop :: TestEnv -> Test
-test_drop env = "git-annex drop" ~: TestList [noremote, withremote, untrustedremote]
- where
- 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 env "drop" [annexedfile] @? "drop wrongly succeeded with no known copy of file"
- annexed_present annexedfile
- git_annex env "drop" ["--force", annexedfile] @? "drop --force failed"
- annexed_notpresent annexedfile
- git_annex env "drop" [annexedfile] @? "drop of dropped file failed"
+test_drop_noremote :: TestEnv -> Assertion
+test_drop_noremote env = intmpclonerepo env $ do
+ git_annex env "get" [annexedfile] @? "get failed"
+ boolSystem "git" [Params "remote rm origin"]
+ @? "git remote rm origin failed"
+ not <$> git_annex env "drop" [annexedfile] @? "drop wrongly succeeded with no known copy of file"
+ annexed_present annexedfile
+ git_annex env "drop" ["--force", annexedfile] @? "drop --force failed"
+ annexed_notpresent annexedfile
+ git_annex env "drop" [annexedfile] @? "drop of dropped file failed"
+ unlessM (annexeval Config.isDirect) $ do
git_annex env "drop" [ingitfile] @? "drop ingitfile should be no-op"
unannexed ingitfile
- withremote = "with remote" ~: TestCase $ intmpclonerepo env $ do
- git_annex env "get" [annexedfile] @? "get failed"
- annexed_present annexedfile
- git_annex env "drop" [annexedfile] @? "drop failed though origin has copy"
- annexed_notpresent annexedfile
- 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 env "drop" [annexedfile] @? "drop wrongly suceeded with only an untrusted copy of the file"
- annexed_present annexedfile
- inmainrepo env $ annexed_present annexedfile
-
-test_get :: TestEnv -> Test
-test_get env = "git-annex get" ~: TestCase $ intmpclonerepo env $ do
+
+test_drop_withremote :: TestEnv -> Assertion
+test_drop_withremote env = intmpclonerepo env $ do
+ git_annex env "get" [annexedfile] @? "get failed"
+ annexed_present annexedfile
+ git_annex env "drop" [annexedfile] @? "drop failed though origin has copy"
+ annexed_notpresent annexedfile
+ inmainrepo env $ annexed_present annexedfile
+
+test_drop_untrustedremote :: TestEnv -> Assertion
+test_drop_untruestedremote env = 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 env "drop" [annexedfile] @? "drop wrongly suceeded with only an untrusted copy of the file"
+ annexed_present annexedfile
+ inmainrepo env $ annexed_present annexedfile
+
+test_get :: TestEnv -> Assertion
+test_get env = intmpclonerepo env $ do
inmainrepo env $ annexed_present annexedfile
annexed_notpresent annexedfile
git_annex env "get" [annexedfile] @? "get of file failed"
@@ -277,14 +309,15 @@ test_get env = "git-annex get" ~: TestCase $ intmpclonerepo env $ do
git_annex env "get" [annexedfile] @? "get of file already here failed"
inmainrepo env $ annexed_present annexedfile
annexed_present annexedfile
- inmainrepo env $ unannexed ingitfile
- unannexed ingitfile
- git_annex env "get" [ingitfile] @? "get ingitfile should be no-op"
- inmainrepo env $ unannexed ingitfile
- unannexed ingitfile
-
-test_move :: TestEnv -> Test
-test_move env = "git-annex move" ~: TestCase $ intmpclonerepo env $ do
+ unlessM (annexeval Config.isDirect) $ do
+ inmainrepo env $ unannexed ingitfile
+ unannexed ingitfile
+ git_annex env "get" [ingitfile] @? "get ingitfile should be no-op"
+ inmainrepo env $ unannexed ingitfile
+ unannexed ingitfile
+
+test_move :: TestEnv -> Assertion
+test_move env = intmpclonerepo env $ do
annexed_notpresent annexedfile
inmainrepo env $ annexed_present annexedfile
git_annex env "move" ["--from", "origin", annexedfile] @? "move --from of file failed"
@@ -299,17 +332,18 @@ test_move env = "git-annex move" ~: TestCase $ intmpclonerepo env $ do
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 env $ unannexed ingitfile
- git_annex env "move" ["--to", "origin", ingitfile] @? "move of ingitfile should be no-op"
- unannexed ingitfile
- inmainrepo env $ unannexed ingitfile
- git_annex env "move" ["--from", "origin", ingitfile] @? "move of ingitfile should be no-op"
- unannexed ingitfile
- inmainrepo env $ unannexed ingitfile
-
-test_copy :: TestEnv -> Test
-test_copy env = "git-annex copy" ~: TestCase $ intmpclonerepo env $ do
+ unlessM (annexeval Config.isDirect) $ do
+ unannexed ingitfile
+ inmainrepo env $ unannexed ingitfile
+ git_annex env "move" ["--to", "origin", ingitfile] @? "move of ingitfile should be no-op"
+ unannexed ingitfile
+ inmainrepo env $ unannexed ingitfile
+ git_annex env "move" ["--from", "origin", ingitfile] @? "move of ingitfile should be no-op"
+ unannexed ingitfile
+ inmainrepo env $ unannexed ingitfile
+
+test_copy :: TestEnv -> Assertion
+test_copy env = intmpclonerepo env $ do
annexed_notpresent annexedfile
inmainrepo env $ annexed_present annexedfile
git_annex env "copy" ["--from", "origin", annexedfile] @? "copy --from of file failed"
@@ -324,30 +358,31 @@ test_copy env = "git-annex copy" ~: TestCase $ intmpclonerepo env $ do
git_annex env "move" ["--to", "origin", annexedfile] @? "move --to of file already there failed"
annexed_notpresent annexedfile
inmainrepo env $ annexed_present annexedfile
- unannexed ingitfile
- inmainrepo env $ unannexed ingitfile
- git_annex env "copy" ["--to", "origin", ingitfile] @? "copy of ingitfile should be no-op"
- unannexed ingitfile
- inmainrepo env $ unannexed ingitfile
- git_annex env "copy" ["--from", "origin", ingitfile] @? "copy of ingitfile should be no-op"
- checkregularfile ingitfile
- checkcontent ingitfile
-
-test_preferred_content :: TestEnv -> Test
-test_preferred_content env = "git-annex preferred-content" ~: TestCase $ intmpclonerepo env $ do
+ unlessM (annexeval Config.isDirect) $ do
+ unannexed ingitfile
+ inmainrepo env $ unannexed ingitfile
+ git_annex env "copy" ["--to", "origin", ingitfile] @? "copy of ingitfile should be no-op"
+ unannexed ingitfile
+ inmainrepo env $ unannexed ingitfile
+ git_annex env "copy" ["--from", "origin", ingitfile] @? "copy of ingitfile should be no-op"
+ checkregularfile ingitfile
+ checkcontent ingitfile
+
+test_preferred_content :: TestEnv -> Assertion
+test_preferred_content env = intmpclonerepo env $ do
annexed_notpresent annexedfile
-- get --auto only looks at numcopies when preferred content is not
-- set, and with 1 copy existing, does not get the file.
git_annex env "get" ["--auto", annexedfile] @? "get --auto of file failed with default preferred content"
annexed_notpresent annexedfile
- git_annex env "content" [".", "standard"] @? "set expression to standard failed"
+ git_annex env "wanted" [".", "standard"] @? "set expression to standard failed"
git_annex env "group" [".", "client"] @? "set group to standard failed"
git_annex env "get" ["--auto", annexedfile] @? "get --auto of file failed for client"
annexed_present annexedfile
git_annex env "ungroup" [".", "client"] @? "ungroup failed"
- git_annex env "content" [".", "standard"] @? "set expression to standard failed"
+ git_annex env "wanted" [".", "standard"] @? "set expression to standard failed"
git_annex env "group" [".", "manual"] @? "set group to manual failed"
-- drop --auto with manual leaves the file where it is
git_annex env "drop" ["--auto", annexedfile] @? "drop --auto of file failed with manual preferred content"
@@ -359,7 +394,7 @@ test_preferred_content env = "git-annex preferred-content" ~: TestCase $ intmpcl
annexed_notpresent annexedfile
git_annex env "ungroup" [".", "client"] @? "ungroup failed"
- git_annex env "content" [".", "exclude=*"] @? "set expression to exclude=* failed"
+ git_annex env "wanted" [".", "exclude=*"] @? "set expression to exclude=* failed"
git_annex env "get" [annexedfile] @? "get of file failed"
annexed_present annexedfile
git_annex env "drop" ["--auto", annexedfile] @? "drop --auto of file failed with exclude=*"
@@ -367,8 +402,8 @@ test_preferred_content env = "git-annex preferred-content" ~: TestCase $ intmpcl
git_annex env "get" ["--auto", annexedfile] @? "get --auto of file failed with exclude=*"
annexed_notpresent annexedfile
-test_lock :: TestEnv -> Test
-test_lock env = "git-annex unlock/lock" ~: intmpclonerepoInDirect env $ do
+test_lock :: TestEnv -> Assertion
+test_lock env = intmpclonerepoInDirect env $ do
-- regression test: unlock of not present file should skip it
annexed_notpresent annexedfile
not <$> git_annex env "unlock" [annexedfile] @? "unlock failed to fail with not present file"
@@ -394,9 +429,14 @@ test_lock env = "git-annex unlock/lock" ~: intmpclonerepoInDirect env $ do
r' <- git_annex env "drop" [annexedfile]
not r' @? "drop wrongly succeeded with no known copy of modified file"
-test_edit :: TestEnv -> Test
-test_edit env = "git-annex edit/commit" ~: TestList [t False, t True]
- where t precommit = TestCase $ intmpclonerepoInDirect env $ do
+test_edit :: TestEnv -> Assertion
+test_edit = test_edit' False
+
+test_edit_precommit :: TestEnv -> Assertion
+test_edit_precommit = test_edit' True
+
+test_edit' :: Bool -> TestEnv -> Assertion
+test_edit' precommit env = intmpclonerepoInDirect env $ do
git_annex env "get" [annexedfile] @? "get of file failed"
annexed_present annexedfile
git_annex env "edit" [annexedfile] @? "edit failed"
@@ -414,8 +454,8 @@ test_edit env = "git-annex edit/commit" ~: TestList [t False, t True]
assertEqual "content of modified file" c (changedcontent annexedfile)
not <$> git_annex env "drop" [annexedfile] @? "drop wrongly succeeded with no known copy of modified file"
-test_fix :: TestEnv -> Test
-test_fix env = "git-annex fix" ~: intmpclonerepoInDirect env $ do
+test_fix :: TestEnv -> Assertion
+test_fix env = intmpclonerepoInDirect env $ do
annexed_notpresent annexedfile
git_annex env "fix" [annexedfile] @? "fix of not present failed"
annexed_notpresent annexedfile
@@ -434,8 +474,8 @@ test_fix env = "git-annex fix" ~: intmpclonerepoInDirect env $ do
subdir = "s"
newfile = subdir ++ "/" ++ annexedfile
-test_trust :: TestEnv -> Test
-test_trust env = "git-annex trust/untrust/semitrust/dead" ~: intmpclonerepo env $ do
+test_trust :: TestEnv -> Assertion
+test_trust env = intmpclonerepo env $ do
git_annex env "trust" [repo] @? "trust failed"
trustcheck Logs.Trust.Trusted "trusted 1"
git_annex env "trust" [repo] @? "trust of trusted failed"
@@ -461,33 +501,15 @@ test_trust env = "git-annex trust/untrust/semitrust/dead" ~: intmpclonerepo env
return $ u `elem` l
assertBool msg present
-test_fsck :: TestEnv -> Test
-test_fsck env = "git-annex fsck" ~: TestList [basicfsck, barefsck, withlocaluntrusted, withremoteuntrusted]
+test_fsck_basic :: TestEnv -> Assertion
+test_fsck_basic env = intmpclonerepo env $ do
+ git_annex env "fsck" [] @? "fsck failed"
+ boolSystem "git" [Params "config annex.numcopies 2"] @? "git config failed"
+ fsck_should_fail env "numcopies unsatisfied"
+ boolSystem "git" [Params "config annex.numcopies 1"] @? "git config failed"
+ corrupt env annexedfile
+ corrupt env sha1annexedfile
where
- 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 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 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 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 env "get" [f] @? "get of file failed"
Utility.FileMode.allowWrite f
@@ -497,12 +519,41 @@ test_fsck env = "git-annex fsck" ~: TestList [basicfsck, barefsck, withlocaluntr
, 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 env "fsck" [] @? "fsck failed to fail with " ++ m
-test_migrate :: TestEnv -> Test
-test_migrate env = "git-annex migrate" ~: TestList [t False, t True]
- where t usegitattributes = TestCase $ intmpclonerepoInDirect env $ do
+test_fsck_bare :: TestEnv -> Assertion
+test_fsck_bare env = intmpbareclonerepo env $ do
+ git_annex env "fsck" [] @? "fsck failed"
+
+test_fsck_localuntrusted :: TestEnv -> Assertion
+test_fsck_localuntrusted env = 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 env "content only available in untrusted (current) repository"
+ git_annex env "trust" ["."] @? "trust of current repo failed"
+ git_annex env "fsck" [annexedfile] @? "fsck failed on file present in trusted repo"
+
+test_fsck_remoteuntrusted :: TestEnv -> Assertion
+test_fsck_remoteuntrusted env = intmpclonerepo env $ do
+ boolSystem "git" [Params "config annex.numcopies 2"] @? "git config 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 env "content not replicated to enough non-untrusted repositories"
+
+fsck_should_fail :: TestEnv -> String -> Assertion
+fsck_should_fail env m = not <$> git_annex env "fsck" []
+ @? "fsck failed to fail with " ++ m
+
+test_migrate :: TestEnv -> Assertion
+test_migrate = test_migrate' False
+
+test_migrate_via_gitattributes :: TestEnv -> Assertion
+test_migrate_via_gitattributes = test_migrate' True
+
+test_migrate' :: Bool -> TestEnv -> Assertion
+test_migrate' usegitattributes env = intmpclonerepoInDirect env $ do
annexed_notpresent annexedfile
annexed_notpresent sha1annexedfile
git_annex env "migrate" [annexedfile] @? "migrate of not present failed"
@@ -539,9 +590,9 @@ test_migrate env = "git-annex migrate" ~: TestList [t False, t True]
checkbackend annexedfile backendSHA256
checkbackend sha1annexedfile backendSHA256
-test_unused :: TestEnv -> Test
+test_unused :: TestEnv -> Assertion
-- This test is broken in direct mode
-test_unused env = "git-annex unused/dropunused" ~: intmpclonerepoInDirect env $ do
+test_unused env = intmpclonerepoInDirect env $ do
-- keys have to be looked up before files are removed
annexedfilekey <- annexeval $ findkey annexedfile
sha1annexedfilekey <- annexeval $ findkey sha1annexedfile
@@ -569,6 +620,37 @@ test_unused env = "git-annex unused/dropunused" ~: intmpclonerepoInDirect env $
checkunused [] "after dropunused"
not <$> git_annex env "dropunused" ["--force", "10", "501"] @? "dropunused failed to fail on bogus numbers"
+ -- unused used to miss symlinks that were not staged and pointed
+ -- at annexed content, and think that content was unused
+ writeFile "unusedfile" "unusedcontent"
+ git_annex env "add" ["unusedfile"] @? "add of unusedfile failed"
+ unusedfilekey <- annexeval $ findkey "unusedfile"
+ renameFile "unusedfile" "unusedunstagedfile"
+ boolSystem "git" [Params "rm -qf", File "unusedfile"] @? "git rm failed"
+ checkunused [] "with unstaged link"
+ removeFile "unusedunstagedfile"
+ checkunused [unusedfilekey] "with unstaged link deleted"
+
+ -- unused used to miss symlinks that were deleted or modified
+ -- manually, but commited as such.
+ writeFile "unusedfile" "unusedcontent"
+ git_annex env "add" ["unusedfile"] @? "add of unusedfile failed"
+ boolSystem "git" [Param "add", File "unusedfile"] @? "git add failed"
+ unusedfilekey' <- annexeval $ findkey "unusedfile"
+ checkunused [] "with staged deleted link"
+ boolSystem "git" [Params "rm -qf", File "unusedfile"] @? "git rm failed"
+ checkunused [unusedfilekey'] "with staged link deleted"
+
+ -- unused used to miss symlinks that were deleted or modified
+ -- manually, but not staged as such.
+ writeFile "unusedfile" "unusedcontent"
+ git_annex env "add" ["unusedfile"] @? "add of unusedfile failed"
+ boolSystem "git" [Param "add", File "unusedfile"] @? "git add failed"
+ unusedfilekey'' <- annexeval $ findkey "unusedfile"
+ checkunused [] "with unstaged deleted link"
+ removeFile "unusedfile"
+ checkunused [unusedfilekey''] "with unstaged link deleted"
+
where
checkunused expectedkeys desc = do
git_annex env "unused" [] @? "unused failed"
@@ -580,13 +662,13 @@ test_unused env = "git-annex unused/dropunused" ~: intmpclonerepoInDirect env $
r <- Backend.lookupFile f
return $ fst $ fromJust r
-test_describe :: TestEnv -> Test
-test_describe env = "git-annex describe" ~: intmpclonerepo env $ do
+test_describe :: TestEnv -> Assertion
+test_describe env = intmpclonerepo env $ do
git_annex env "describe" [".", "this repo"] @? "describe 1 failed"
git_annex env "describe" ["origin", "origin repo"] @? "describe 2 failed"
-test_find :: TestEnv -> Test
-test_find env = "git-annex find" ~: intmpclonerepo env $ do
+test_find :: TestEnv -> Assertion
+test_find env = intmpclonerepo env $ do
annexed_notpresent annexedfile
git_annex_expectoutput env "find" [] []
git_annex env "get" [annexedfile] @? "get failed"
@@ -608,23 +690,23 @@ test_find env = "git-annex find" ~: intmpclonerepo env $ do
git_annex_expectoutput env "find" ["--include", "*", "--exclude", annexedfile, "--exclude", sha1annexedfile] ["dir/subfile"]
git_annex_expectoutput env "find" ["--exclude", "*"] []
-test_merge :: TestEnv -> Test
-test_merge env = "git-annex merge" ~: intmpclonerepo env $ do
+test_merge :: TestEnv -> Assertion
+test_merge env = intmpclonerepo env $ do
git_annex env "merge" [] @? "merge failed"
-test_status :: TestEnv -> Test
-test_status env = "git-annex status" ~: intmpclonerepo env $ do
- json <- git_annex_output env "status" ["--json"]
+test_info :: TestEnv -> Assertion
+test_info env = intmpclonerepo env $ do
+ json <- git_annex_output env "info" ["--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 :: TestEnv -> Test
-test_version env = "git-annex version" ~: intmpclonerepo env $ do
+test_version :: TestEnv -> Assertion
+test_version env = intmpclonerepo env $ do
git_annex env "version" [] @? "version failed"
-test_sync :: TestEnv -> Test
-test_sync env = "git-annex sync" ~: intmpclonerepo env $ do
+test_sync :: TestEnv -> Assertion
+test_sync env = intmpclonerepo env $ do
git_annex env "sync" [] @? "sync failed"
{- Regression test for bug fixed in
- 7b0970b340d7faeb745c666146c7f701ec71808f, where in direct mode
@@ -633,8 +715,8 @@ test_sync env = "git-annex sync" ~: intmpclonerepo env $ do
{- Regression test for union merge bug fixed in
- 0214e0fb175a608a49b812d81b4632c081f63027 -}
-test_union_merge_regression :: TestEnv -> Test
-test_union_merge_regression env = "union merge regression" ~:
+test_union_merge_regression :: TestEnv -> Assertion
+test_union_merge_regression env =
{- We need 3 repos to see this bug. -}
withtmpclonerepo env False $ \r1 -> do
withtmpclonerepo env False $ \r2 -> do
@@ -662,73 +744,100 @@ test_union_merge_regression env = "union merge regression" ~:
{- Regression test for the automatic conflict resolution bug fixed
- in f4ba19f2b8a76a1676da7bb5850baa40d9c388e2. -}
-test_conflict_resolution :: TestEnv -> Test
-test_conflict_resolution env = "automatic conflict resolution" ~:
- withtmpclonerepo env False $ \r1 -> do
+test_conflict_resolution :: TestEnv -> Assertion
+test_conflict_resolution_movein_bug env = withtmpclonerepo env False $ \r1 -> do
+ withtmpclonerepo env False $ \r2 -> do
+ let rname r = if r == r1 then "r1" else "r2"
+ forM_ [r1, r2] $ \r -> indir env r $ do
+ {- Get all files, see check below. -}
+ git_annex env "get" [] @? "get failed"
+ pair env r1 r2
+ forM_ [r1, r2] $ \r -> indir env r $ do
+ {- Set up a conflict. -}
+ let newcontent = content annexedfile ++ rname r
+ ifM (annexeval Config.isDirect)
+ ( writeFile annexedfile newcontent
+ , do
+ git_annex env "unlock" [annexedfile] @? "unlock failed"
+ writeFile annexedfile newcontent
+ )
+ {- Sync twice in r1 so it gets the conflict resolution
+ - update from r2 -}
+ forM_ [r1, r2, r1] $ \r -> indir env r $ do
+ git_annex env "sync" ["--force"] @? "sync failed in " ++ rname r
+ {- After the sync, it should be possible to get all
+ - files. This includes both sides of the conflict,
+ - although the filenames are not easily predictable.
+ -
+ - The bug caused, in direct mode, one repo to
+ - be missing the content of the file that had
+ - been put in it. -}
+ forM_ [r1, r2] $ \r -> indir env r $ do
+ git_annex env "get" [] @? "unable to get all files after merge conflict resolution in " ++ rname r
+
+{- Check merge conflict resolution when one side is an annexed
+ - file, and the other is a directory. -}
+test_mixed_conflict_resolution :: TestEnv -> Assertion
+test_mixed_conflict_resolution env = do
+ check_mixed_conflict True
+ check_mixed_conflict False
+ where
+ check_mixed_conflict inr1 = withtmpclonerepo env False $ \r1 ->
withtmpclonerepo env False $ \r2 -> do
- let rname r = if r == r1 then "r1" else "r2"
- forM_ [r1, r2] $ \r -> indir env r $ do
- {- Get all files, see check below. -}
- git_annex env "get" [] @? "get failed"
- {- Set up repos as remotes of each other;
- - remove origin since we're going to sync
- - some changes to a file. -}
- 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"
- boolSystem "git" [Params "remote rm origin"] @? "remote rm"
-
- {- Set up a conflict. -}
- let newcontent = content annexedfile ++ rname r
- ifM (annexeval Config.isDirect)
- ( writeFile annexedfile newcontent
- , do
- git_annex env "unlock" [annexedfile] @? "unlock failed"
- writeFile annexedfile newcontent
- )
- {- Sync twice in r1 so it gets the conflict resolution
- - update from r2 -}
- forM_ [r1, r2, r1] $ \r -> indir env r $ do
- git_annex env "sync" [] @? "sync failed in " ++ rname r
- {- After the sync, it should be possible to get all
- - files. This includes both sides of the conflict,
- - although the filenames are not easily predictable.
- -
- - The bug caused, in direct mode, one repo to
- - be missing the content of the file that had
- - been put in it. -}
- forM_ [r1, r2] $ \r -> indir env r $ do
- git_annex env "get" [] @? "unable to get all files after merge conflict resolution in " ++ rname r
-
-test_map :: TestEnv -> Test
-test_map env = "git-annex map" ~: intmpclonerepo env $ do
+ indir env r1 $ do
+ writeFile conflictor "conflictor"
+ git_annex env "add" [conflictor] @? "add conflicter failed"
+ git_annex env "sync" [] @? "sync failed"
+ indir env r2 $ do
+ createDirectory conflictor
+ writeFile (conflictor </> "subfile") "subfile"
+ git_annex env "add" [conflictor] @? "add conflicter failed"
+ git_annex env "sync" [] @? "sync failed"
+ pair env r1 r2
+ let r = if inr1 then r1 else r2
+ indir env r $ do
+ git_annex env "sync" [] @? "sync failed in mixed conflict"
+ where
+ conflictor = "conflictor"
+
+{- Set up repos as remotes of each other;
+ - remove origin since we're going to sync
+ - some changes to a file. -}
+pair :: TestEnv -> FilePath -> FilePath -> Assertion
+pair env r1 r2 = forM_ [r1, r2] $ \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"
+ boolSystem "git" [Params "remote rm origin"] @? "remote rm"
+
+test_map :: TestEnv -> Assertion
+test_map env = intmpclonerepo env $ do
-- set descriptions, that will be looked for in the map
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 env "map" ["--fast"] @? "map failed"
-test_uninit :: TestEnv -> Test
-test_uninit env = "git-annex uninit" ~: TestList [inbranch, normal]
- where
- inbranch = "in branch" ~: intmpclonerepoInDirect env $ do
- boolSystem "git" [Params "checkout git-annex"] @? "git checkout git-annex"
- not <$> git_annex env "uninit" [] @? "uninit failed to fail when git-annex branch was checked out"
- normal = "normal" ~: intmpclonerepo env $ do
- git_annex env "get" [] @? "get failed"
- annexed_present annexedfile
- _ <- 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 :: TestEnv -> Test
-test_upgrade env = "git-annex upgrade" ~: intmpclonerepo env $ do
+test_uninit :: TestEnv -> Assertion
+test_uninit env = intmpclonerepo env $ do
+ git_annex env "get" [] @? "get failed"
+ annexed_present annexedfile
+ _ <- git_annex env "uninit" [] -- exit status not checked; does abnormal exit
+ checkregularfile annexedfile
+ doesDirectoryExist ".git" @? ".git vanished in uninit"
+
+test_uninit_inbranch :: TestEnv -> Assertion
+test_uninit_inbranch env = intmpclonerepoInDirect env $ do
+ boolSystem "git" [Params "checkout git-annex"] @? "git checkout git-annex"
+ not <$> git_annex env "uninit" [] @? "uninit failed to fail when git-annex branch was checked out"
+
+test_upgrade :: TestEnv -> Assertion
+test_upgrade env = intmpclonerepo env $ do
git_annex env "upgrade" [] @? "upgrade from same version failed"
-test_whereis :: TestEnv -> Test
-test_whereis env = "git-annex whereis" ~: intmpclonerepo env $ do
+test_whereis :: TestEnv -> Assertion
+test_whereis env = intmpclonerepo env $ do
annexed_notpresent annexedfile
git_annex env "whereis" [annexedfile] @? "whereis on non-present file failed"
git_annex env "untrust" ["origin"] @? "untrust failed"
@@ -737,8 +846,8 @@ test_whereis env = "git-annex whereis" ~: intmpclonerepo env $ do
annexed_present annexedfile
git_annex env "whereis" [annexedfile] @? "whereis on present file failed"
-test_hook_remote :: TestEnv -> Test
-test_hook_remote env = "git-annex hook remote" ~: intmpclonerepo env $ do
+test_hook_remote :: TestEnv -> Assertion
+test_hook_remote env = intmpclonerepo env $ do
#ifndef mingw32_HOST_OS
git_annex env "initremote" (words "foo type=hook encryption=none hooktype=foo") @? "initremote failed"
createDirectory dir
@@ -770,8 +879,8 @@ test_hook_remote env = "git-annex hook remote" ~: intmpclonerepo env $ do
noop
#endif
-test_directory_remote :: TestEnv -> Test
-test_directory_remote env = "git-annex directory remote" ~: intmpclonerepo env $ do
+test_directory_remote :: TestEnv -> Assertion
+test_directory_remote env = intmpclonerepo env $ do
createDirectory "dir"
git_annex env "initremote" (words $ "foo type=directory encryption=none directory=dir") @? "initremote failed"
git_annex env "get" [annexedfile] @? "get of file failed"
@@ -785,8 +894,8 @@ test_directory_remote env = "git-annex directory remote" ~: intmpclonerepo env $
not <$> git_annex env "drop" [annexedfile, "--numcopies=2"] @? "drop failed to fail"
annexed_present annexedfile
-test_rsync_remote :: TestEnv -> Test
-test_rsync_remote env = "git-annex rsync remote" ~: intmpclonerepo env $ do
+test_rsync_remote :: TestEnv -> Assertion
+test_rsync_remote env = intmpclonerepo env $ do
#ifndef mingw32_HOST_OS
createDirectory "dir"
git_annex env "initremote" (words $ "foo type=rsync encryption=none rsyncurl=dir") @? "initremote failed"
@@ -805,8 +914,8 @@ test_rsync_remote env = "git-annex rsync remote" ~: intmpclonerepo env $ do
noop
#endif
-test_bup_remote :: TestEnv -> Test
-test_bup_remote env = "git-annex bup remote" ~: intmpclonerepo env $ when Build.SysConfig.bup $ do
+test_bup_remote :: TestEnv -> Assertion
+test_bup_remote env = intmpclonerepo env $ when Build.SysConfig.bup $ do
dir <- absPath "dir" -- bup special remote needs an absolute path
createDirectory dir
git_annex env "initremote" (words $ "foo type=bup encryption=none buprepo="++dir) @? "initremote failed"
@@ -822,35 +931,78 @@ test_bup_remote env = "git-annex bup remote" ~: intmpclonerepo env $ when Build.
annexed_present annexedfile
-- gpg is not a build dependency, so only test when it's available
-test_crypto :: TestEnv -> Test
-test_crypto env = "git-annex crypto" ~: intmpclonerepo env $ whenM (Utility.Path.inPath Utility.Gpg.gpgcmd) $ do
+test_crypto :: TestEnv -> Assertion
#ifndef mingw32_HOST_OS
- Utility.Gpg.testTestHarness @? "test harness self-test failed"
- Utility.Gpg.testHarness $ do
- createDirectory "dir"
- let a cmd = git_annex env cmd
- [ "foo"
- , "type=directory"
- , "encryption=" ++ Utility.Gpg.testKeyId
- , "directory=dir"
- , "highRandomQuality=false"
- ]
- a "initremote" @? "initremote failed"
- 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 env "get" [annexedfile] @? "get of file failed"
- annexed_present annexedfile
- git_annex env "copy" [annexedfile, "--to", "foo"] @? "copy --to encrypted remote failed"
- annexed_present annexedfile
- git_annex env "drop" [annexedfile, "--numcopies=2"] @? "drop failed"
- annexed_notpresent annexedfile
- git_annex env "move" [annexedfile, "--from", "foo"] @? "move --from encrypted remote failed"
- annexed_present annexedfile
- not <$> git_annex env "drop" [annexedfile, "--numcopies=2"] @? "drop failed to fail"
- annexed_present annexedfile
+test_crypto env = do
+ testscheme "shared"
+ testscheme "hybrid"
+ testscheme "pubkey"
+ where
+ testscheme scheme = intmpclonerepo env $ whenM (Utility.Path.inPath Utility.Gpg.gpgcmd) $ do
+ Utility.Gpg.testTestHarness @? "test harness self-test failed"
+ Utility.Gpg.testHarness $ do
+ createDirectory "dir"
+ let a cmd = git_annex env cmd $
+ [ "foo"
+ , "type=directory"
+ , "encryption=" ++ scheme
+ , "directory=dir"
+ , "highRandomQuality=false"
+ ] ++ if scheme `elem` ["hybrid","pubkey"]
+ then ["keyid=" ++ Utility.Gpg.testKeyId]
+ else []
+ a "initremote" @? "initremote failed"
+ 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 env "get" [annexedfile] @? "get of file failed"
+ annexed_present annexedfile
+ git_annex env "copy" [annexedfile, "--to", "foo"] @? "copy --to encrypted remote failed"
+ (c,k) <- annexeval $ do
+ uuid <- Remote.nameToUUID "foo"
+ rs <- Logs.Remote.readRemoteLog
+ Just (k,_) <- Backend.lookupFile annexedfile
+ return (fromJust $ M.lookup uuid rs, k)
+ let key = if scheme `elem` ["hybrid","pubkey"]
+ then Just $ Utility.Gpg.KeyIds [Utility.Gpg.testKeyId]
+ else Nothing
+ testEncryptedRemote scheme key c [k] @? "invalid crypto setup"
+
+ annexed_present annexedfile
+ git_annex env "drop" [annexedfile, "--numcopies=2"] @? "drop failed"
+ annexed_notpresent annexedfile
+ git_annex env "move" [annexedfile, "--from", "foo"] @? "move --from encrypted remote failed"
+ annexed_present annexedfile
+ not <$> git_annex env "drop" [annexedfile, "--numcopies=2"] @? "drop failed to fail"
+ annexed_present annexedfile
+ {- Ensure the configuration complies with the encryption scheme, and
+ - that all keys are encrypted properly for the given directory remote. -}
+ testEncryptedRemote scheme ks c keys = case Remote.Helper.Encryptable.extractCipher c of
+ Just cip@Crypto.SharedCipher{} | scheme == "shared" && isNothing ks ->
+ checkKeys cip Nothing
+ Just cip@(Crypto.EncryptedCipher encipher v ks')
+ | checkScheme v && keysMatch ks' ->
+ checkKeys cip (Just v) <&&> checkCipher encipher ks'
+ _ -> return False
+ where
+ keysMatch (Utility.Gpg.KeyIds ks') =
+ maybe False (\(Utility.Gpg.KeyIds ks2) ->
+ sort (nub ks2) == sort (nub ks')) ks
+ checkCipher encipher = Utility.Gpg.checkEncryptionStream encipher . Just
+ checkScheme Types.Crypto.Hybrid = scheme == "hybrid"
+ checkScheme Types.Crypto.PubKey = scheme == "pubkey"
+ checkKeys cip mvariant = do
+ cipher <- Crypto.decryptCipher cip
+ files <- filterM doesFileExist $
+ map ("dir" </>) $ concatMap (key2files cipher) keys
+ return (not $ null files) <&&> allM (checkFile mvariant) files
+ checkFile mvariant filename =
+ Utility.Gpg.checkEncryptionFile filename $
+ if mvariant == Just Types.Crypto.PubKey then ks else Nothing
+ key2files cipher = Locations.keyPaths .
+ Crypto.encryptKey Types.Crypto.HmacSha1 cipher
#else
- putStrLn "gpg testing not implemented on Windows"
+test_crypto _env = putStrLn "gpg testing not implemented on Windows"
#endif
-- This is equivilant to running git-annex, but it's all run in-process