finished converting test suite for tasty
Also merged in Test.hs from master.
This commit is contained in:
parent
8189738b13
commit
cf93636df8
1 changed files with 386 additions and 234 deletions
620
Test.hs
620
Test.hs
|
@ -36,6 +36,7 @@ import qualified Types.KeySource
|
||||||
import qualified Types.Backend
|
import qualified Types.Backend
|
||||||
import qualified Types.TrustLevel
|
import qualified Types.TrustLevel
|
||||||
import qualified Types
|
import qualified Types
|
||||||
|
import qualified Logs
|
||||||
import qualified Logs.UUIDBased
|
import qualified Logs.UUIDBased
|
||||||
import qualified Logs.Trust
|
import qualified Logs.Trust
|
||||||
import qualified Logs.Remote
|
import qualified Logs.Remote
|
||||||
|
@ -58,11 +59,16 @@ import qualified Utility.Process
|
||||||
import qualified Utility.Misc
|
import qualified Utility.Misc
|
||||||
import qualified Utility.InodeCache
|
import qualified Utility.InodeCache
|
||||||
import qualified Utility.Env
|
import qualified Utility.Env
|
||||||
import qualified Utility.Gpg
|
|
||||||
import qualified Utility.Matcher
|
import qualified Utility.Matcher
|
||||||
import qualified Utility.Exception
|
import qualified Utility.Exception
|
||||||
|
import qualified Utility.Hash
|
||||||
|
import qualified Utility.Scheduled
|
||||||
|
import qualified Utility.HumanTime
|
||||||
#ifndef mingw32_HOST_OS
|
#ifndef mingw32_HOST_OS
|
||||||
import qualified GitAnnex
|
import qualified GitAnnex
|
||||||
|
import qualified Remote.Helper.Encryptable
|
||||||
|
import qualified Types.Crypto
|
||||||
|
import qualified Utility.Gpg
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
type TestEnv = M.Map String String
|
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_deencode" Utility.Format.prop_idempotent_deencode
|
||||||
, testProperty "prop_idempotent_fileKey" Locations.prop_idempotent_fileKey
|
, testProperty "prop_idempotent_fileKey" Locations.prop_idempotent_fileKey
|
||||||
, testProperty "prop_idempotent_key_encode" Types.Key.prop_idempotent_key_encode
|
, 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" Utility.SafeCommand.prop_idempotent_shellEscape
|
||||||
, testProperty "prop_idempotent_shellEscape_multiword" Utility.SafeCommand.prop_idempotent_shellEscape_multiword
|
, 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_idempotent_configEscape" Logs.Remote.prop_idempotent_configEscape
|
||||||
, testProperty "prop_parse_show_Config" Logs.Remote.prop_parse_show_Config
|
, testProperty "prop_parse_show_Config" Logs.Remote.prop_parse_show_Config
|
||||||
, testProperty "prop_parentDir_basics" Utility.Path.prop_parentDir_basics
|
, 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_parse_show_log" Logs.Presence.prop_parse_show_log
|
||||||
, testProperty "prop_read_show_TrustLevel" Types.TrustLevel.prop_read_show_TrustLevel
|
, testProperty "prop_read_show_TrustLevel" Types.TrustLevel.prop_read_show_TrustLevel
|
||||||
, testProperty "prop_parse_show_TrustLog" Logs.Trust.prop_parse_show_TrustLog
|
, 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
|
unitTests :: TestEnv -> String -> TestTree
|
||||||
|
@ -119,30 +130,39 @@ unitTests env note = testGroup ("Unit Tests " ++ note)
|
||||||
, check "add" test_add
|
, check "add" test_add
|
||||||
, check "add sha1dup" test_add_sha1dup
|
, check "add sha1dup" test_add_sha1dup
|
||||||
, check "add subdirs" test_add_subdirs
|
, check "add subdirs" test_add_subdirs
|
||||||
{-
|
|
||||||
, check "reinject" test_reinject
|
, check "reinject" test_reinject
|
||||||
, check "unannex" test_unannex
|
, check "unannex (no copy)" test_unannex_nocopy
|
||||||
, check "drop" test_drop
|
, 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 "get" test_get
|
||||||
, check "move" test_move
|
, check "move" test_move
|
||||||
, check "copy" test_copy
|
, check "copy" test_copy
|
||||||
, check "lock" test_lock
|
, 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 "fix" test_fix
|
||||||
, check "trust" test_trust
|
, 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" test_migrate
|
||||||
|
, check "migrate (via gitattributes)" test_migrate_via_gitattributes
|
||||||
, check" unused" test_unused
|
, check" unused" test_unused
|
||||||
, check "describe" test_describe
|
, check "describe" test_describe
|
||||||
, check "find" test_find
|
, check "find" test_find
|
||||||
, check "merge" test_merge
|
, check "merge" test_merge
|
||||||
, check "status" test_status
|
, check "info" test_info
|
||||||
, check "version" test_version
|
, check "version" test_version
|
||||||
, check "sync" test_sync
|
, check "sync" test_sync
|
||||||
, check "union merge regression" test_union_merge_regression
|
, check "union merge regression" test_union_merge_regression
|
||||||
, check "conflict resolution" test_conflict_resolution
|
, check "conflict resolution" test_conflict_resolution
|
||||||
|
, check "conflict_resolution (mixed directory and file)" test_mixed_conflict_resolution
|
||||||
, check "map" test_map
|
, check "map" test_map
|
||||||
, check "uninit" test_uninit
|
, check "uninit" test_uninit
|
||||||
|
, check "uninit (in git-annex branch)" test_uninit_inbranch
|
||||||
, check "upgrade" test_upgrade
|
, check "upgrade" test_upgrade
|
||||||
, check "whereis" test_whereis
|
, check "whereis" test_whereis
|
||||||
, check "hook remote" test_hook_remote
|
, check "hook remote" test_hook_remote
|
||||||
|
@ -151,7 +171,6 @@ unitTests env note = testGroup ("Unit Tests " ++ note)
|
||||||
, check "bup remote" test_bup_remote
|
, check "bup remote" test_bup_remote
|
||||||
, check "crypto" test_crypto
|
, check "crypto" test_crypto
|
||||||
, check "preferred content" test_preferred_content
|
, check "preferred content" test_preferred_content
|
||||||
-}
|
|
||||||
, check "global cleanup" test_global_cleanup
|
, check "global cleanup" test_global_cleanup
|
||||||
]
|
]
|
||||||
where
|
where
|
||||||
|
@ -182,12 +201,21 @@ test_add env = inmainrepo env $ do
|
||||||
git_annex env "add" [wormannexedfile, "--backend=WORM"] @? "add with WORM failed"
|
git_annex env "add" [wormannexedfile, "--backend=WORM"] @? "add with WORM failed"
|
||||||
annexed_present wormannexedfile
|
annexed_present wormannexedfile
|
||||||
checkbackend wormannexedfile backendWORM
|
checkbackend wormannexedfile backendWORM
|
||||||
boolSystem "git" [Params "rm --force -q", File wormannexedfile] @? "git rm failed"
|
ifM (annexeval Config.isDirect)
|
||||||
writeFile ingitfile $ content ingitfile
|
( do
|
||||||
boolSystem "git" [Param "add", File ingitfile] @? "git add failed"
|
boolSystem "rm" [Params "-f", File wormannexedfile] @? "rm failed"
|
||||||
boolSystem "git" [Params "commit -q -m commit"] @? "git commit failed"
|
writeFile ingitfile $ content ingitfile
|
||||||
git_annex env "add" [ingitfile] @? "add ingitfile should be no-op"
|
not <$> boolSystem "git" [Param "add", File ingitfile] @? "git add failed to fail in direct mode"
|
||||||
unannexed ingitfile
|
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 :: TestEnv -> Assertion
|
||||||
test_add_sha1dup env = intmpclonerepo env $ do
|
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"
|
git_annex env "add" [".." </> "dir2"] @? "add of ../subdir failed"
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
test_reinject :: TestEnv -> Test
|
test_reinject :: TestEnv -> Assertion
|
||||||
test_reinject env = "git-annex reinject/fromkey" ~: TestCase $ intmpclonerepoInDirect env $ do
|
test_reinject env = intmpclonerepoInDirect env $ do
|
||||||
git_annex env "drop" ["--force", sha1annexedfile] @? "drop failed"
|
git_annex env "drop" ["--force", sha1annexedfile] @? "drop failed"
|
||||||
writeFile tmp $ content sha1annexedfile
|
writeFile tmp $ content sha1annexedfile
|
||||||
r <- annexeval $ Types.Backend.getKey backendSHA1 $
|
r <- annexeval $ Types.Backend.getKey backendSHA1 $
|
||||||
|
@ -222,53 +250,57 @@ test_reinject env = "git-annex reinject/fromkey" ~: TestCase $ intmpclonerepoInD
|
||||||
where
|
where
|
||||||
tmp = "tmpfile"
|
tmp = "tmpfile"
|
||||||
|
|
||||||
test_unannex :: TestEnv -> Test
|
test_unannex_nocopy :: TestEnv -> Assertion
|
||||||
test_unannex env = "git-annex unannex" ~: TestList [nocopy, withcopy]
|
test_unannex_nocopy env = intmpclonerepo env $ do
|
||||||
where
|
annexed_notpresent annexedfile
|
||||||
nocopy = "no content" ~: intmpclonerepo env $ do
|
git_annex env "unannex" [annexedfile] @? "unannex failed with no copy"
|
||||||
annexed_notpresent annexedfile
|
annexed_notpresent annexedfile
|
||||||
git_annex env "unannex" [annexedfile] @? "unannex failed with no copy"
|
|
||||||
annexed_notpresent annexedfile
|
test_unannex_withcopy :: TestEnv -> Assertion
|
||||||
withcopy = "with content" ~: intmpclonerepo env $ do
|
test_unannex_withcopy env = intmpclonerepo env $ do
|
||||||
git_annex env "get" [annexedfile] @? "get failed"
|
git_annex env "get" [annexedfile] @? "get failed"
|
||||||
annexed_present annexedfile
|
annexed_present annexedfile
|
||||||
git_annex env "unannex" [annexedfile, sha1annexedfile] @? "unannex failed"
|
git_annex env "unannex" [annexedfile, sha1annexedfile] @? "unannex failed"
|
||||||
unannexed annexedfile
|
unannexed annexedfile
|
||||||
git_annex env "unannex" [annexedfile] @? "unannex failed on non-annexed file"
|
git_annex env "unannex" [annexedfile] @? "unannex failed on non-annexed file"
|
||||||
unannexed annexedfile
|
unannexed annexedfile
|
||||||
|
unlessM (annexeval Config.isDirect) $ do
|
||||||
git_annex env "unannex" [ingitfile] @? "unannex ingitfile should be no-op"
|
git_annex env "unannex" [ingitfile] @? "unannex ingitfile should be no-op"
|
||||||
unannexed ingitfile
|
unannexed ingitfile
|
||||||
|
|
||||||
test_drop :: TestEnv -> Test
|
test_drop_noremote :: TestEnv -> Assertion
|
||||||
test_drop env = "git-annex drop" ~: TestList [noremote, withremote, untrustedremote]
|
test_drop_noremote env = intmpclonerepo env $ do
|
||||||
where
|
git_annex env "get" [annexedfile] @? "get failed"
|
||||||
noremote = "no remotes" ~: TestCase $ intmpclonerepo env $ do
|
boolSystem "git" [Params "remote rm origin"]
|
||||||
git_annex env "get" [annexedfile] @? "get failed"
|
@? "git remote rm origin failed"
|
||||||
boolSystem "git" [Params "remote rm origin"]
|
not <$> git_annex env "drop" [annexedfile] @? "drop wrongly succeeded with no known copy of file"
|
||||||
@? "git remote rm origin failed"
|
annexed_present annexedfile
|
||||||
not <$> git_annex env "drop" [annexedfile] @? "drop wrongly succeeded with no known copy of file"
|
git_annex env "drop" ["--force", annexedfile] @? "drop --force failed"
|
||||||
annexed_present annexedfile
|
annexed_notpresent annexedfile
|
||||||
git_annex env "drop" ["--force", annexedfile] @? "drop --force failed"
|
git_annex env "drop" [annexedfile] @? "drop of dropped file failed"
|
||||||
annexed_notpresent annexedfile
|
unlessM (annexeval Config.isDirect) $ do
|
||||||
git_annex env "drop" [annexedfile] @? "drop of dropped file failed"
|
|
||||||
git_annex env "drop" [ingitfile] @? "drop ingitfile should be no-op"
|
git_annex env "drop" [ingitfile] @? "drop ingitfile should be no-op"
|
||||||
unannexed ingitfile
|
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_drop_withremote :: TestEnv -> Assertion
|
||||||
test_get env = "git-annex get" ~: TestCase $ intmpclonerepo env $ do
|
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
|
inmainrepo env $ annexed_present annexedfile
|
||||||
annexed_notpresent annexedfile
|
annexed_notpresent annexedfile
|
||||||
git_annex env "get" [annexedfile] @? "get of file failed"
|
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"
|
git_annex env "get" [annexedfile] @? "get of file already here failed"
|
||||||
inmainrepo env $ annexed_present annexedfile
|
inmainrepo env $ annexed_present annexedfile
|
||||||
annexed_present annexedfile
|
annexed_present annexedfile
|
||||||
inmainrepo env $ unannexed ingitfile
|
unlessM (annexeval Config.isDirect) $ do
|
||||||
unannexed ingitfile
|
inmainrepo env $ unannexed ingitfile
|
||||||
git_annex env "get" [ingitfile] @? "get ingitfile should be no-op"
|
unannexed ingitfile
|
||||||
inmainrepo env $ unannexed ingitfile
|
git_annex env "get" [ingitfile] @? "get ingitfile should be no-op"
|
||||||
unannexed ingitfile
|
inmainrepo env $ unannexed ingitfile
|
||||||
|
unannexed ingitfile
|
||||||
|
|
||||||
test_move :: TestEnv -> Test
|
test_move :: TestEnv -> Assertion
|
||||||
test_move env = "git-annex move" ~: TestCase $ intmpclonerepo env $ do
|
test_move env = intmpclonerepo env $ do
|
||||||
annexed_notpresent annexedfile
|
annexed_notpresent annexedfile
|
||||||
inmainrepo env $ annexed_present annexedfile
|
inmainrepo env $ annexed_present annexedfile
|
||||||
git_annex env "move" ["--from", "origin", annexedfile] @? "move --from of file failed"
|
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"
|
git_annex env "move" ["--to", "origin", annexedfile] @? "move --to of file already there failed"
|
||||||
inmainrepo env $ annexed_present annexedfile
|
inmainrepo env $ annexed_present annexedfile
|
||||||
annexed_notpresent annexedfile
|
annexed_notpresent annexedfile
|
||||||
unannexed ingitfile
|
unlessM (annexeval Config.isDirect) $ do
|
||||||
inmainrepo env $ unannexed ingitfile
|
unannexed ingitfile
|
||||||
git_annex env "move" ["--to", "origin", ingitfile] @? "move of ingitfile should be no-op"
|
inmainrepo env $ unannexed ingitfile
|
||||||
unannexed ingitfile
|
git_annex env "move" ["--to", "origin", ingitfile] @? "move of ingitfile should be no-op"
|
||||||
inmainrepo env $ unannexed ingitfile
|
unannexed ingitfile
|
||||||
git_annex env "move" ["--from", "origin", ingitfile] @? "move of ingitfile should be no-op"
|
inmainrepo env $ unannexed ingitfile
|
||||||
unannexed ingitfile
|
git_annex env "move" ["--from", "origin", ingitfile] @? "move of ingitfile should be no-op"
|
||||||
inmainrepo env $ unannexed ingitfile
|
unannexed ingitfile
|
||||||
|
inmainrepo env $ unannexed ingitfile
|
||||||
|
|
||||||
test_copy :: TestEnv -> Test
|
test_copy :: TestEnv -> Assertion
|
||||||
test_copy env = "git-annex copy" ~: TestCase $ intmpclonerepo env $ do
|
test_copy env = intmpclonerepo env $ do
|
||||||
annexed_notpresent annexedfile
|
annexed_notpresent annexedfile
|
||||||
inmainrepo env $ annexed_present annexedfile
|
inmainrepo env $ annexed_present annexedfile
|
||||||
git_annex env "copy" ["--from", "origin", annexedfile] @? "copy --from of file failed"
|
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"
|
git_annex env "move" ["--to", "origin", annexedfile] @? "move --to of file already there failed"
|
||||||
annexed_notpresent annexedfile
|
annexed_notpresent annexedfile
|
||||||
inmainrepo env $ annexed_present annexedfile
|
inmainrepo env $ annexed_present annexedfile
|
||||||
unannexed ingitfile
|
unlessM (annexeval Config.isDirect) $ do
|
||||||
inmainrepo env $ unannexed ingitfile
|
unannexed ingitfile
|
||||||
git_annex env "copy" ["--to", "origin", ingitfile] @? "copy of ingitfile should be no-op"
|
inmainrepo env $ unannexed ingitfile
|
||||||
unannexed ingitfile
|
git_annex env "copy" ["--to", "origin", ingitfile] @? "copy of ingitfile should be no-op"
|
||||||
inmainrepo env $ unannexed ingitfile
|
unannexed ingitfile
|
||||||
git_annex env "copy" ["--from", "origin", ingitfile] @? "copy of ingitfile should be no-op"
|
inmainrepo env $ unannexed ingitfile
|
||||||
checkregularfile ingitfile
|
git_annex env "copy" ["--from", "origin", ingitfile] @? "copy of ingitfile should be no-op"
|
||||||
checkcontent ingitfile
|
checkregularfile ingitfile
|
||||||
|
checkcontent ingitfile
|
||||||
|
|
||||||
test_preferred_content :: TestEnv -> Test
|
test_preferred_content :: TestEnv -> Assertion
|
||||||
test_preferred_content env = "git-annex preferred-content" ~: TestCase $ intmpclonerepo env $ do
|
test_preferred_content env = intmpclonerepo env $ do
|
||||||
annexed_notpresent annexedfile
|
annexed_notpresent annexedfile
|
||||||
-- get --auto only looks at numcopies when preferred content is not
|
-- get --auto only looks at numcopies when preferred content is not
|
||||||
-- set, and with 1 copy existing, does not get the file.
|
-- 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"
|
git_annex env "get" ["--auto", annexedfile] @? "get --auto of file failed with default preferred content"
|
||||||
annexed_notpresent annexedfile
|
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 "group" [".", "client"] @? "set group to standard failed"
|
||||||
git_annex env "get" ["--auto", annexedfile] @? "get --auto of file failed for client"
|
git_annex env "get" ["--auto", annexedfile] @? "get --auto of file failed for client"
|
||||||
annexed_present annexedfile
|
annexed_present annexedfile
|
||||||
git_annex env "ungroup" [".", "client"] @? "ungroup failed"
|
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"
|
git_annex env "group" [".", "manual"] @? "set group to manual failed"
|
||||||
-- drop --auto with manual leaves the file where it is
|
-- 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"
|
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
|
annexed_notpresent annexedfile
|
||||||
git_annex env "ungroup" [".", "client"] @? "ungroup failed"
|
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"
|
git_annex env "get" [annexedfile] @? "get of file failed"
|
||||||
annexed_present annexedfile
|
annexed_present annexedfile
|
||||||
git_annex env "drop" ["--auto", annexedfile] @? "drop --auto of file failed with exclude=*"
|
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=*"
|
git_annex env "get" ["--auto", annexedfile] @? "get --auto of file failed with exclude=*"
|
||||||
annexed_notpresent annexedfile
|
annexed_notpresent annexedfile
|
||||||
|
|
||||||
test_lock :: TestEnv -> Test
|
test_lock :: TestEnv -> Assertion
|
||||||
test_lock env = "git-annex unlock/lock" ~: intmpclonerepoInDirect env $ do
|
test_lock env = intmpclonerepoInDirect env $ do
|
||||||
-- regression test: unlock of not present file should skip it
|
-- regression test: unlock of not present file should skip it
|
||||||
annexed_notpresent annexedfile
|
annexed_notpresent annexedfile
|
||||||
not <$> git_annex env "unlock" [annexedfile] @? "unlock failed to fail with not present file"
|
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]
|
r' <- git_annex env "drop" [annexedfile]
|
||||||
not r' @? "drop wrongly succeeded with no known copy of modified file"
|
not r' @? "drop wrongly succeeded with no known copy of modified file"
|
||||||
|
|
||||||
test_edit :: TestEnv -> Test
|
test_edit :: TestEnv -> Assertion
|
||||||
test_edit env = "git-annex edit/commit" ~: TestList [t False, t True]
|
test_edit = test_edit' False
|
||||||
where t precommit = TestCase $ intmpclonerepoInDirect env $ do
|
|
||||||
|
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"
|
git_annex env "get" [annexedfile] @? "get of file failed"
|
||||||
annexed_present annexedfile
|
annexed_present annexedfile
|
||||||
git_annex env "edit" [annexedfile] @? "edit failed"
|
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)
|
assertEqual "content of modified file" c (changedcontent annexedfile)
|
||||||
not <$> git_annex env "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 :: TestEnv -> Test
|
test_fix :: TestEnv -> Assertion
|
||||||
test_fix env = "git-annex fix" ~: intmpclonerepoInDirect env $ do
|
test_fix env = intmpclonerepoInDirect env $ do
|
||||||
annexed_notpresent annexedfile
|
annexed_notpresent annexedfile
|
||||||
git_annex env "fix" [annexedfile] @? "fix of not present failed"
|
git_annex env "fix" [annexedfile] @? "fix of not present failed"
|
||||||
annexed_notpresent annexedfile
|
annexed_notpresent annexedfile
|
||||||
|
@ -434,8 +474,8 @@ test_fix env = "git-annex fix" ~: intmpclonerepoInDirect env $ do
|
||||||
subdir = "s"
|
subdir = "s"
|
||||||
newfile = subdir ++ "/" ++ annexedfile
|
newfile = subdir ++ "/" ++ annexedfile
|
||||||
|
|
||||||
test_trust :: TestEnv -> Test
|
test_trust :: TestEnv -> Assertion
|
||||||
test_trust env = "git-annex trust/untrust/semitrust/dead" ~: intmpclonerepo env $ do
|
test_trust env = intmpclonerepo env $ do
|
||||||
git_annex env "trust" [repo] @? "trust failed"
|
git_annex env "trust" [repo] @? "trust failed"
|
||||||
trustcheck Logs.Trust.Trusted "trusted 1"
|
trustcheck Logs.Trust.Trusted "trusted 1"
|
||||||
git_annex env "trust" [repo] @? "trust of trusted failed"
|
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
|
return $ u `elem` l
|
||||||
assertBool msg present
|
assertBool msg present
|
||||||
|
|
||||||
test_fsck :: TestEnv -> Test
|
test_fsck_basic :: TestEnv -> Assertion
|
||||||
test_fsck env = "git-annex fsck" ~: TestList [basicfsck, barefsck, withlocaluntrusted, withremoteuntrusted]
|
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
|
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
|
corrupt f = do
|
||||||
git_annex env "get" [f] @? "get of file failed"
|
git_annex env "get" [f] @? "get of file failed"
|
||||||
Utility.FileMode.allowWrite f
|
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"
|
, 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
|
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_fsck_bare :: TestEnv -> Assertion
|
||||||
test_migrate env = "git-annex migrate" ~: TestList [t False, t True]
|
test_fsck_bare env = intmpbareclonerepo env $ do
|
||||||
where t usegitattributes = TestCase $ intmpclonerepoInDirect 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 annexedfile
|
||||||
annexed_notpresent sha1annexedfile
|
annexed_notpresent sha1annexedfile
|
||||||
git_annex env "migrate" [annexedfile] @? "migrate of not present failed"
|
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 annexedfile backendSHA256
|
||||||
checkbackend sha1annexedfile backendSHA256
|
checkbackend sha1annexedfile backendSHA256
|
||||||
|
|
||||||
test_unused :: TestEnv -> Test
|
test_unused :: TestEnv -> Assertion
|
||||||
-- This test is broken in direct mode
|
-- 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
|
-- keys have to be looked up before files are removed
|
||||||
annexedfilekey <- annexeval $ findkey annexedfile
|
annexedfilekey <- annexeval $ findkey annexedfile
|
||||||
sha1annexedfilekey <- annexeval $ findkey sha1annexedfile
|
sha1annexedfilekey <- annexeval $ findkey sha1annexedfile
|
||||||
|
@ -569,6 +620,37 @@ test_unused env = "git-annex unused/dropunused" ~: intmpclonerepoInDirect env $
|
||||||
checkunused [] "after dropunused"
|
checkunused [] "after dropunused"
|
||||||
not <$> git_annex env "dropunused" ["--force", "10", "501"] @? "dropunused failed to fail on bogus numbers"
|
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
|
where
|
||||||
checkunused expectedkeys desc = do
|
checkunused expectedkeys desc = do
|
||||||
git_annex env "unused" [] @? "unused failed"
|
git_annex env "unused" [] @? "unused failed"
|
||||||
|
@ -580,13 +662,13 @@ test_unused env = "git-annex unused/dropunused" ~: intmpclonerepoInDirect env $
|
||||||
r <- Backend.lookupFile f
|
r <- Backend.lookupFile f
|
||||||
return $ fst $ fromJust r
|
return $ fst $ fromJust r
|
||||||
|
|
||||||
test_describe :: TestEnv -> Test
|
test_describe :: TestEnv -> Assertion
|
||||||
test_describe env = "git-annex describe" ~: intmpclonerepo env $ do
|
test_describe env = intmpclonerepo env $ do
|
||||||
git_annex env "describe" [".", "this repo"] @? "describe 1 failed"
|
git_annex env "describe" [".", "this repo"] @? "describe 1 failed"
|
||||||
git_annex env "describe" ["origin", "origin repo"] @? "describe 2 failed"
|
git_annex env "describe" ["origin", "origin repo"] @? "describe 2 failed"
|
||||||
|
|
||||||
test_find :: TestEnv -> Test
|
test_find :: TestEnv -> Assertion
|
||||||
test_find env = "git-annex find" ~: intmpclonerepo env $ do
|
test_find env = intmpclonerepo env $ do
|
||||||
annexed_notpresent annexedfile
|
annexed_notpresent annexedfile
|
||||||
git_annex_expectoutput env "find" [] []
|
git_annex_expectoutput env "find" [] []
|
||||||
git_annex env "get" [annexedfile] @? "get failed"
|
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" ["--include", "*", "--exclude", annexedfile, "--exclude", sha1annexedfile] ["dir/subfile"]
|
||||||
git_annex_expectoutput env "find" ["--exclude", "*"] []
|
git_annex_expectoutput env "find" ["--exclude", "*"] []
|
||||||
|
|
||||||
test_merge :: TestEnv -> Test
|
test_merge :: TestEnv -> Assertion
|
||||||
test_merge env = "git-annex merge" ~: intmpclonerepo env $ do
|
test_merge env = intmpclonerepo env $ do
|
||||||
git_annex env "merge" [] @? "merge failed"
|
git_annex env "merge" [] @? "merge failed"
|
||||||
|
|
||||||
test_status :: TestEnv -> Test
|
test_info :: TestEnv -> Assertion
|
||||||
test_status env = "git-annex status" ~: intmpclonerepo env $ do
|
test_info env = intmpclonerepo env $ do
|
||||||
json <- git_annex_output env "status" ["--json"]
|
json <- git_annex_output env "info" ["--json"]
|
||||||
case Text.JSON.decodeStrict json :: Text.JSON.Result (Text.JSON.JSObject Text.JSON.JSValue) of
|
case Text.JSON.decodeStrict json :: Text.JSON.Result (Text.JSON.JSObject Text.JSON.JSValue) of
|
||||||
Text.JSON.Ok _ -> return ()
|
Text.JSON.Ok _ -> return ()
|
||||||
Text.JSON.Error e -> assertFailure e
|
Text.JSON.Error e -> assertFailure e
|
||||||
|
|
||||||
test_version :: TestEnv -> Test
|
test_version :: TestEnv -> Assertion
|
||||||
test_version env = "git-annex version" ~: intmpclonerepo env $ do
|
test_version env = intmpclonerepo env $ do
|
||||||
git_annex env "version" [] @? "version failed"
|
git_annex env "version" [] @? "version failed"
|
||||||
|
|
||||||
test_sync :: TestEnv -> Test
|
test_sync :: TestEnv -> Assertion
|
||||||
test_sync env = "git-annex sync" ~: intmpclonerepo env $ do
|
test_sync env = intmpclonerepo env $ do
|
||||||
git_annex env "sync" [] @? "sync failed"
|
git_annex env "sync" [] @? "sync failed"
|
||||||
{- Regression test for bug fixed in
|
{- Regression test for bug fixed in
|
||||||
- 7b0970b340d7faeb745c666146c7f701ec71808f, where in direct mode
|
- 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
|
{- Regression test for union merge bug fixed in
|
||||||
- 0214e0fb175a608a49b812d81b4632c081f63027 -}
|
- 0214e0fb175a608a49b812d81b4632c081f63027 -}
|
||||||
test_union_merge_regression :: TestEnv -> Test
|
test_union_merge_regression :: TestEnv -> Assertion
|
||||||
test_union_merge_regression env = "union merge regression" ~:
|
test_union_merge_regression env =
|
||||||
{- We need 3 repos to see this bug. -}
|
{- We need 3 repos to see this bug. -}
|
||||||
withtmpclonerepo env False $ \r1 -> do
|
withtmpclonerepo env False $ \r1 -> do
|
||||||
withtmpclonerepo env False $ \r2 -> 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
|
{- Regression test for the automatic conflict resolution bug fixed
|
||||||
- in f4ba19f2b8a76a1676da7bb5850baa40d9c388e2. -}
|
- in f4ba19f2b8a76a1676da7bb5850baa40d9c388e2. -}
|
||||||
test_conflict_resolution :: TestEnv -> Test
|
test_conflict_resolution :: TestEnv -> Assertion
|
||||||
test_conflict_resolution env = "automatic conflict resolution" ~:
|
test_conflict_resolution_movein_bug env = withtmpclonerepo env False $ \r1 -> do
|
||||||
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
|
withtmpclonerepo env False $ \r2 -> do
|
||||||
let rname r = if r == r1 then "r1" else "r2"
|
indir env r1 $ do
|
||||||
forM_ [r1, r2] $ \r -> indir env r $ do
|
writeFile conflictor "conflictor"
|
||||||
{- Get all files, see check below. -}
|
git_annex env "add" [conflictor] @? "add conflicter failed"
|
||||||
git_annex env "get" [] @? "get failed"
|
git_annex env "sync" [] @? "sync failed"
|
||||||
{- Set up repos as remotes of each other;
|
indir env r2 $ do
|
||||||
- remove origin since we're going to sync
|
createDirectory conflictor
|
||||||
- some changes to a file. -}
|
writeFile (conflictor </> "subfile") "subfile"
|
||||||
when (r /= r1) $
|
git_annex env "add" [conflictor] @? "add conflicter failed"
|
||||||
boolSystem "git" [Params "remote add r1", File ("../../" ++ r1)] @? "remote add"
|
git_annex env "sync" [] @? "sync failed"
|
||||||
when (r /= r2) $
|
pair env r1 r2
|
||||||
boolSystem "git" [Params "remote add r2", File ("../../" ++ r2)] @? "remote add"
|
let r = if inr1 then r1 else r2
|
||||||
boolSystem "git" [Params "remote rm origin"] @? "remote rm"
|
indir env r $ do
|
||||||
|
git_annex env "sync" [] @? "sync failed in mixed conflict"
|
||||||
|
where
|
||||||
|
conflictor = "conflictor"
|
||||||
|
|
||||||
{- Set up a conflict. -}
|
{- Set up repos as remotes of each other;
|
||||||
let newcontent = content annexedfile ++ rname r
|
- remove origin since we're going to sync
|
||||||
ifM (annexeval Config.isDirect)
|
- some changes to a file. -}
|
||||||
( writeFile annexedfile newcontent
|
pair :: TestEnv -> FilePath -> FilePath -> Assertion
|
||||||
, do
|
pair env r1 r2 = forM_ [r1, r2] $ \r -> indir env r $ do
|
||||||
git_annex env "unlock" [annexedfile] @? "unlock failed"
|
when (r /= r1) $
|
||||||
writeFile annexedfile newcontent
|
boolSystem "git" [Params "remote add r1", File ("../../" ++ r1)] @? "remote add"
|
||||||
)
|
when (r /= r2) $
|
||||||
{- Sync twice in r1 so it gets the conflict resolution
|
boolSystem "git" [Params "remote add r2", File ("../../" ++ r2)] @? "remote add"
|
||||||
- update from r2 -}
|
boolSystem "git" [Params "remote rm origin"] @? "remote rm"
|
||||||
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 :: TestEnv -> Assertion
|
||||||
test_map env = "git-annex map" ~: intmpclonerepo env $ do
|
test_map env = intmpclonerepo env $ do
|
||||||
-- set descriptions, that will be looked for in the map
|
-- set descriptions, that will be looked for in the map
|
||||||
git_annex env "describe" [".", "this repo"] @? "describe 1 failed"
|
git_annex env "describe" [".", "this repo"] @? "describe 1 failed"
|
||||||
git_annex env "describe" ["origin", "origin repo"] @? "describe 2 failed"
|
git_annex env "describe" ["origin", "origin repo"] @? "describe 2 failed"
|
||||||
-- --fast avoids it running graphviz, not a build dependency
|
-- --fast avoids it running graphviz, not a build dependency
|
||||||
git_annex env "map" ["--fast"] @? "map failed"
|
git_annex env "map" ["--fast"] @? "map failed"
|
||||||
|
|
||||||
test_uninit :: TestEnv -> Test
|
test_uninit :: TestEnv -> Assertion
|
||||||
test_uninit env = "git-annex uninit" ~: TestList [inbranch, normal]
|
test_uninit env = intmpclonerepo env $ do
|
||||||
where
|
git_annex env "get" [] @? "get failed"
|
||||||
inbranch = "in branch" ~: intmpclonerepoInDirect env $ do
|
annexed_present annexedfile
|
||||||
boolSystem "git" [Params "checkout git-annex"] @? "git checkout git-annex"
|
_ <- git_annex env "uninit" [] -- exit status not checked; does abnormal exit
|
||||||
not <$> git_annex env "uninit" [] @? "uninit failed to fail when git-annex branch was checked out"
|
checkregularfile annexedfile
|
||||||
normal = "normal" ~: intmpclonerepo env $ do
|
doesDirectoryExist ".git" @? ".git vanished in uninit"
|
||||||
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_uninit_inbranch :: TestEnv -> Assertion
|
||||||
test_upgrade env = "git-annex upgrade" ~: intmpclonerepo env $ do
|
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"
|
git_annex env "upgrade" [] @? "upgrade from same version failed"
|
||||||
|
|
||||||
test_whereis :: TestEnv -> Test
|
test_whereis :: TestEnv -> Assertion
|
||||||
test_whereis env = "git-annex whereis" ~: intmpclonerepo env $ do
|
test_whereis env = intmpclonerepo env $ do
|
||||||
annexed_notpresent annexedfile
|
annexed_notpresent annexedfile
|
||||||
git_annex env "whereis" [annexedfile] @? "whereis on non-present file failed"
|
git_annex env "whereis" [annexedfile] @? "whereis on non-present file failed"
|
||||||
git_annex env "untrust" ["origin"] @? "untrust failed"
|
git_annex env "untrust" ["origin"] @? "untrust failed"
|
||||||
|
@ -737,8 +846,8 @@ test_whereis env = "git-annex whereis" ~: intmpclonerepo env $ do
|
||||||
annexed_present annexedfile
|
annexed_present annexedfile
|
||||||
git_annex env "whereis" [annexedfile] @? "whereis on present file failed"
|
git_annex env "whereis" [annexedfile] @? "whereis on present file failed"
|
||||||
|
|
||||||
test_hook_remote :: TestEnv -> Test
|
test_hook_remote :: TestEnv -> Assertion
|
||||||
test_hook_remote env = "git-annex hook remote" ~: intmpclonerepo env $ do
|
test_hook_remote env = intmpclonerepo env $ do
|
||||||
#ifndef mingw32_HOST_OS
|
#ifndef mingw32_HOST_OS
|
||||||
git_annex env "initremote" (words "foo type=hook encryption=none hooktype=foo") @? "initremote failed"
|
git_annex env "initremote" (words "foo type=hook encryption=none hooktype=foo") @? "initremote failed"
|
||||||
createDirectory dir
|
createDirectory dir
|
||||||
|
@ -770,8 +879,8 @@ test_hook_remote env = "git-annex hook remote" ~: intmpclonerepo env $ do
|
||||||
noop
|
noop
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
test_directory_remote :: TestEnv -> Test
|
test_directory_remote :: TestEnv -> Assertion
|
||||||
test_directory_remote env = "git-annex directory remote" ~: intmpclonerepo env $ do
|
test_directory_remote env = intmpclonerepo env $ do
|
||||||
createDirectory "dir"
|
createDirectory "dir"
|
||||||
git_annex env "initremote" (words $ "foo type=directory encryption=none directory=dir") @? "initremote failed"
|
git_annex env "initremote" (words $ "foo type=directory encryption=none directory=dir") @? "initremote failed"
|
||||||
git_annex env "get" [annexedfile] @? "get of file 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"
|
not <$> git_annex env "drop" [annexedfile, "--numcopies=2"] @? "drop failed to fail"
|
||||||
annexed_present annexedfile
|
annexed_present annexedfile
|
||||||
|
|
||||||
test_rsync_remote :: TestEnv -> Test
|
test_rsync_remote :: TestEnv -> Assertion
|
||||||
test_rsync_remote env = "git-annex rsync remote" ~: intmpclonerepo env $ do
|
test_rsync_remote env = intmpclonerepo env $ do
|
||||||
#ifndef mingw32_HOST_OS
|
#ifndef mingw32_HOST_OS
|
||||||
createDirectory "dir"
|
createDirectory "dir"
|
||||||
git_annex env "initremote" (words $ "foo type=rsync encryption=none rsyncurl=dir") @? "initremote failed"
|
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
|
noop
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
test_bup_remote :: TestEnv -> Test
|
test_bup_remote :: TestEnv -> Assertion
|
||||||
test_bup_remote env = "git-annex bup remote" ~: intmpclonerepo env $ when Build.SysConfig.bup $ do
|
test_bup_remote env = intmpclonerepo env $ when Build.SysConfig.bup $ do
|
||||||
dir <- absPath "dir" -- bup special remote needs an absolute path
|
dir <- absPath "dir" -- bup special remote needs an absolute path
|
||||||
createDirectory dir
|
createDirectory dir
|
||||||
git_annex env "initremote" (words $ "foo type=bup encryption=none buprepo="++dir) @? "initremote failed"
|
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
|
annexed_present annexedfile
|
||||||
|
|
||||||
-- gpg is not a build dependency, so only test when it's available
|
-- gpg is not a build dependency, so only test when it's available
|
||||||
test_crypto :: TestEnv -> Test
|
test_crypto :: TestEnv -> Assertion
|
||||||
test_crypto env = "git-annex crypto" ~: intmpclonerepo env $ whenM (Utility.Path.inPath Utility.Gpg.gpgcmd) $ do
|
|
||||||
#ifndef mingw32_HOST_OS
|
#ifndef mingw32_HOST_OS
|
||||||
Utility.Gpg.testTestHarness @? "test harness self-test failed"
|
test_crypto env = do
|
||||||
Utility.Gpg.testHarness $ do
|
testscheme "shared"
|
||||||
createDirectory "dir"
|
testscheme "hybrid"
|
||||||
let a cmd = git_annex env cmd
|
testscheme "pubkey"
|
||||||
[ "foo"
|
where
|
||||||
, "type=directory"
|
testscheme scheme = intmpclonerepo env $ whenM (Utility.Path.inPath Utility.Gpg.gpgcmd) $ do
|
||||||
, "encryption=" ++ Utility.Gpg.testKeyId
|
Utility.Gpg.testTestHarness @? "test harness self-test failed"
|
||||||
, "directory=dir"
|
Utility.Gpg.testHarness $ do
|
||||||
, "highRandomQuality=false"
|
createDirectory "dir"
|
||||||
]
|
let a cmd = git_annex env cmd $
|
||||||
a "initremote" @? "initremote failed"
|
[ "foo"
|
||||||
not <$> a "initremote" @? "initremote failed to fail when run twice in a row"
|
, "type=directory"
|
||||||
a "enableremote" @? "enableremote failed"
|
, "encryption=" ++ scheme
|
||||||
a "enableremote" @? "enableremote failed when run twice in a row"
|
, "directory=dir"
|
||||||
git_annex env "get" [annexedfile] @? "get of file failed"
|
, "highRandomQuality=false"
|
||||||
annexed_present annexedfile
|
] ++ if scheme `elem` ["hybrid","pubkey"]
|
||||||
git_annex env "copy" [annexedfile, "--to", "foo"] @? "copy --to encrypted remote failed"
|
then ["keyid=" ++ Utility.Gpg.testKeyId]
|
||||||
annexed_present annexedfile
|
else []
|
||||||
git_annex env "drop" [annexedfile, "--numcopies=2"] @? "drop failed"
|
a "initremote" @? "initremote failed"
|
||||||
annexed_notpresent annexedfile
|
not <$> a "initremote" @? "initremote failed to fail when run twice in a row"
|
||||||
git_annex env "move" [annexedfile, "--from", "foo"] @? "move --from encrypted remote failed"
|
a "enableremote" @? "enableremote failed"
|
||||||
annexed_present annexedfile
|
a "enableremote" @? "enableremote failed when run twice in a row"
|
||||||
not <$> git_annex env "drop" [annexedfile, "--numcopies=2"] @? "drop failed to fail"
|
git_annex env "get" [annexedfile] @? "get of file failed"
|
||||||
annexed_present annexedfile
|
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
|
#else
|
||||||
putStrLn "gpg testing not implemented on Windows"
|
test_crypto _env = putStrLn "gpg testing not implemented on Windows"
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
-- This is equivilant to running git-annex, but it's all run in-process
|
-- This is equivilant to running git-annex, but it's all run in-process
|
||||||
|
|
Loading…
Reference in a new issue