diff options
Diffstat (limited to 'Test.hs')
| -rw-r--r-- | Test.hs | 1122 |
1 files changed, 553 insertions, 569 deletions
@@ -80,8 +80,6 @@ import qualified Types.Crypto import qualified Utility.Gpg #endif -type TestEnv = M.Map String String - main :: [String] -> IO () main ps = do let tests = testGroup "Tests" @@ -169,88 +167,84 @@ properties = localOption (QuickCheckTests 1000) $ testGroup "QuickCheck" {- These tests set up the test environment, but also test some basic parts - of git-annex. They are always run before the unitTests. -} -initTests :: TestEnv -> TestTree -initTests testenv = testGroup "Init Tests" - [ check "init" test_init - , check "add" test_add +initTests :: TestTree +initTests = testGroup "Init Tests" + [ testCase "init" test_init + , testCase "add" test_add ] - where - check desc t = testCase desc (t testenv) - -unitTests :: String -> IO TestEnv -> TestTree -unitTests note gettestenv = testGroup ("Unit Tests " ++ note) - [ check "add sha1dup" test_add_sha1dup - , check "add extras" test_add_extras - , check "reinject" test_reinject - , 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 (no pre-commit)" test_edit - , check "edit (pre-commit)" test_edit_precommit - , check "partial commit" test_partial_commit - , check "fix" test_fix - , check "trust" test_trust - , 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 "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 movein regression" test_conflict_resolution_movein_regression - , check "conflict resolution (mixed directory and file)" test_mixed_conflict_resolution - , check "conflict resolution symlink bit" test_conflict_resolution_symlink_bit - , check "conflict resolution (uncommitted local file)" test_uncommitted_conflict_resolution - , check "conflict resolution (removed file)" test_remove_conflict_resolution - , check "conflict resolution (nonannexed file)" test_nonannexed_file_conflict_resolution - , check "conflict resolution (nonannexed symlink)" test_nonannexed_symlink_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 - , check "directory remote" test_directory_remote - , check "rsync remote" test_rsync_remote - , check "bup remote" test_bup_remote - , check "crypto" test_crypto - , check "preferred content" test_preferred_content - , check "add subdirs" test_add_subdirs + +unitTests :: String -> TestTree +unitTests note = testGroup ("Unit Tests " ++ note) + [ testCase "add sha1dup" test_add_sha1dup + , testCase "add extras" test_add_extras + , testCase "reinject" test_reinject + , testCase "unannex (no copy)" test_unannex_nocopy + , testCase "unannex (with copy)" test_unannex_withcopy + , testCase "drop (no remote)" test_drop_noremote + , testCase "drop (with remote)" test_drop_withremote + , testCase "drop (untrusted remote)" test_drop_untrustedremote + , testCase "get" test_get + , testCase "move" test_move + , testCase "copy" test_copy + , testCase "lock" test_lock + , testCase "edit (no pre-commit)" test_edit + , testCase "edit (pre-commit)" test_edit_precommit + , testCase "partial commit" test_partial_commit + , testCase "fix" test_fix + , testCase "trust" test_trust + , testCase "fsck (basics)" test_fsck_basic + , testCase "fsck (bare)" test_fsck_bare + , testCase "fsck (local untrusted)" test_fsck_localuntrusted + , testCase "fsck (remote untrusted)" test_fsck_remoteuntrusted + , testCase "migrate" test_migrate + , testCase "migrate (via gitattributes)" test_migrate_via_gitattributes + , testCase "unused" test_unused + , testCase "describe" test_describe + , testCase "find" test_find + , testCase "merge" test_merge + , testCase "info" test_info + , testCase "version" test_version + , testCase "sync" test_sync + , testCase "union merge regression" test_union_merge_regression + , testCase "conflict resolution" test_conflict_resolution + , testCase "conflict resolution movein regression" test_conflict_resolution_movein_regression + , testCase "conflict resolution (mixed directory and file)" test_mixed_conflict_resolution + , testCase "conflict resolution symlink bit" test_conflict_resolution_symlink_bit + , testCase "conflict resolution (uncommitted local file)" test_uncommitted_conflict_resolution + , testCase "conflict resolution (removed file)" test_remove_conflict_resolution + , testCase "conflict resolution (nonannexed file)" test_nonannexed_file_conflict_resolution + , testCase "conflict resolution (nonannexed symlink)" test_nonannexed_symlink_conflict_resolution + , testCase "map" test_map + , testCase "uninit" test_uninit + , testCase "uninit (in git-annex branch)" test_uninit_inbranch + , testCase "upgrade" test_upgrade + , testCase "whereis" test_whereis + , testCase "hook remote" test_hook_remote + , testCase "directory remote" test_directory_remote + , testCase "rsync remote" test_rsync_remote + , testCase "bup remote" test_bup_remote + , testCase "crypto" test_crypto + , testCase "preferred content" test_preferred_content + , testCase "add subdirs" test_add_subdirs ] - where - check desc t = testCase desc (gettestenv >>= t) -- this test case create the main repo -test_init :: TestEnv -> Assertion -test_init testenv = innewrepo testenv $ do - git_annex testenv "init" [reponame] @? "init failed" - handleforcedirect testenv +test_init :: Assertion +test_init = innewrepo $ do + git_annex "init" [reponame] @? "init failed" + handleforcedirect where reponame = "test repo" -- this test case runs in the main repo, to set up a basic -- annexed file that later tests will use -test_add :: TestEnv -> Assertion -test_add testenv = inmainrepo testenv $ do +test_add :: Assertion +test_add = inmainrepo $ do writeFile annexedfile $ content annexedfile - git_annex testenv "add" [annexedfile] @? "add failed" + git_annex "add" [annexedfile] @? "add failed" annexed_present annexedfile writeFile sha1annexedfile $ content sha1annexedfile - git_annex testenv "add" [sha1annexedfile, "--backend=SHA1"] @? "add with SHA1 failed" + git_annex "add" [sha1annexedfile, "--backend=SHA1"] @? "add with SHA1 failed" annexed_present sha1annexedfile checkbackend sha1annexedfile backendSHA1 ifM (annexeval Config.isDirect) @@ -258,271 +252,271 @@ test_add testenv = inmainrepo testenv $ do writeFile ingitfile $ content ingitfile not <$> boolSystem "git" [Param "add", File ingitfile] @? "git add failed to fail in direct mode" nukeFile ingitfile - git_annex testenv "sync" [] @? "sync failed" + git_annex "sync" [] @? "sync failed" , do 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 testenv "add" [ingitfile] @? "add ingitfile should be no-op" + git_annex "add" [ingitfile] @? "add ingitfile should be no-op" unannexed ingitfile ) -test_add_sha1dup :: TestEnv -> Assertion -test_add_sha1dup testenv = intmpclonerepo testenv $ do +test_add_sha1dup :: Assertion +test_add_sha1dup = intmpclonerepo $ do writeFile sha1annexedfiledup $ content sha1annexedfiledup - git_annex testenv "add" [sha1annexedfiledup, "--backend=SHA1"] @? "add of second file with same SHA1 failed" + git_annex "add" [sha1annexedfiledup, "--backend=SHA1"] @? "add of second file with same SHA1 failed" annexed_present sha1annexedfiledup annexed_present sha1annexedfile -test_add_extras :: TestEnv -> Assertion -test_add_extras testenv = intmpclonerepo testenv $ do +test_add_extras :: Assertion +test_add_extras = intmpclonerepo $ do writeFile wormannexedfile $ content wormannexedfile - git_annex testenv "add" [wormannexedfile, "--backend=WORM"] @? "add with WORM failed" + git_annex "add" [wormannexedfile, "--backend=WORM"] @? "add with WORM failed" annexed_present wormannexedfile checkbackend wormannexedfile backendWORM -test_reinject :: TestEnv -> Assertion -test_reinject testenv = intmpclonerepoInDirect testenv $ do - git_annex testenv "drop" ["--force", sha1annexedfile] @? "drop failed" +test_reinject :: Assertion +test_reinject = intmpclonerepoInDirect $ do + git_annex "drop" ["--force", sha1annexedfile] @? "drop failed" writeFile tmp $ content sha1annexedfile r <- annexeval $ Types.Backend.getKey backendSHA1 Types.KeySource.KeySource { Types.KeySource.keyFilename = tmp, Types.KeySource.contentLocation = tmp, Types.KeySource.inodeCache = Nothing } let key = Types.Key.key2file $ fromJust r - git_annex testenv "reinject" [tmp, sha1annexedfile] @? "reinject failed" - git_annex testenv "fromkey" [key, sha1annexedfiledup] @? "fromkey failed for dup" + git_annex "reinject" [tmp, sha1annexedfile] @? "reinject failed" + git_annex "fromkey" [key, sha1annexedfiledup] @? "fromkey failed for dup" annexed_present sha1annexedfiledup where tmp = "tmpfile" -test_unannex_nocopy :: TestEnv -> Assertion -test_unannex_nocopy testenv = intmpclonerepo testenv $ do +test_unannex_nocopy :: Assertion +test_unannex_nocopy = intmpclonerepo $ do annexed_notpresent annexedfile - git_annex testenv "unannex" [annexedfile] @? "unannex failed with no copy" + git_annex "unannex" [annexedfile] @? "unannex failed with no copy" annexed_notpresent annexedfile -test_unannex_withcopy :: TestEnv -> Assertion -test_unannex_withcopy testenv = intmpclonerepo testenv $ do - git_annex testenv "get" [annexedfile] @? "get failed" +test_unannex_withcopy :: Assertion +test_unannex_withcopy = intmpclonerepo $ do + git_annex "get" [annexedfile] @? "get failed" annexed_present annexedfile - git_annex testenv "unannex" [annexedfile, sha1annexedfile] @? "unannex failed" + git_annex "unannex" [annexedfile, sha1annexedfile] @? "unannex failed" unannexed annexedfile - git_annex testenv "unannex" [annexedfile] @? "unannex failed on non-annexed file" + git_annex "unannex" [annexedfile] @? "unannex failed on non-annexed file" unannexed annexedfile unlessM (annexeval Config.isDirect) $ do - git_annex testenv "unannex" [ingitfile] @? "unannex ingitfile should be no-op" + git_annex "unannex" [ingitfile] @? "unannex ingitfile should be no-op" unannexed ingitfile -test_drop_noremote :: TestEnv -> Assertion -test_drop_noremote testenv = intmpclonerepo testenv $ do - git_annex testenv "get" [annexedfile] @? "get failed" +test_drop_noremote :: Assertion +test_drop_noremote = intmpclonerepo $ do + git_annex "get" [annexedfile] @? "get failed" boolSystem "git" [Params "remote rm origin"] @? "git remote rm origin failed" - not <$> git_annex testenv "drop" [annexedfile] @? "drop wrongly succeeded with no known copy of file" + not <$> git_annex "drop" [annexedfile] @? "drop wrongly succeeded with no known copy of file" annexed_present annexedfile - git_annex testenv "drop" ["--force", annexedfile] @? "drop --force failed" + git_annex "drop" ["--force", annexedfile] @? "drop --force failed" annexed_notpresent annexedfile - git_annex testenv "drop" [annexedfile] @? "drop of dropped file failed" + git_annex "drop" [annexedfile] @? "drop of dropped file failed" unlessM (annexeval Config.isDirect) $ do - git_annex testenv "drop" [ingitfile] @? "drop ingitfile should be no-op" + git_annex "drop" [ingitfile] @? "drop ingitfile should be no-op" unannexed ingitfile -test_drop_withremote :: TestEnv -> Assertion -test_drop_withremote testenv = intmpclonerepo testenv $ do - git_annex testenv "get" [annexedfile] @? "get failed" +test_drop_withremote :: Assertion +test_drop_withremote = intmpclonerepo $ do + git_annex "get" [annexedfile] @? "get failed" annexed_present annexedfile - git_annex testenv "numcopies" ["2"] @? "numcopies config failed" - not <$> git_annex testenv "drop" [annexedfile] @? "drop succeeded although numcopies is not satisfied" - git_annex testenv "numcopies" ["1"] @? "numcopies config failed" - git_annex testenv "drop" [annexedfile] @? "drop failed though origin has copy" + git_annex "numcopies" ["2"] @? "numcopies config failed" + not <$> git_annex "drop" [annexedfile] @? "drop succeeded although numcopies is not satisfied" + git_annex "numcopies" ["1"] @? "numcopies config failed" + git_annex "drop" [annexedfile] @? "drop failed though origin has copy" annexed_notpresent annexedfile - inmainrepo testenv $ annexed_present annexedfile + inmainrepo $ annexed_present annexedfile -test_drop_untrustedremote :: TestEnv -> Assertion -test_drop_untrustedremote testenv = intmpclonerepo testenv $ do - git_annex testenv "untrust" ["origin"] @? "untrust of origin failed" - git_annex testenv "get" [annexedfile] @? "get failed" +test_drop_untrustedremote :: Assertion +test_drop_untrustedremote = intmpclonerepo $ do + git_annex "untrust" ["origin"] @? "untrust of origin failed" + git_annex "get" [annexedfile] @? "get failed" annexed_present annexedfile - not <$> git_annex testenv "drop" [annexedfile] @? "drop wrongly suceeded with only an untrusted copy of the file" + not <$> git_annex "drop" [annexedfile] @? "drop wrongly suceeded with only an untrusted copy of the file" annexed_present annexedfile - inmainrepo testenv $ annexed_present annexedfile + inmainrepo $ annexed_present annexedfile -test_get :: TestEnv -> Assertion -test_get testenv = intmpclonerepo testenv $ do - inmainrepo testenv $ annexed_present annexedfile +test_get :: Assertion +test_get = intmpclonerepo $ do + inmainrepo $ annexed_present annexedfile annexed_notpresent annexedfile - git_annex testenv "get" [annexedfile] @? "get of file failed" - inmainrepo testenv $ annexed_present annexedfile + git_annex "get" [annexedfile] @? "get of file failed" + inmainrepo $ annexed_present annexedfile annexed_present annexedfile - git_annex testenv "get" [annexedfile] @? "get of file already here failed" - inmainrepo testenv $ annexed_present annexedfile + git_annex "get" [annexedfile] @? "get of file already here failed" + inmainrepo $ annexed_present annexedfile annexed_present annexedfile unlessM (annexeval Config.isDirect) $ do - inmainrepo testenv $ unannexed ingitfile + inmainrepo $ unannexed ingitfile unannexed ingitfile - git_annex testenv "get" [ingitfile] @? "get ingitfile should be no-op" - inmainrepo testenv $ unannexed ingitfile + git_annex "get" [ingitfile] @? "get ingitfile should be no-op" + inmainrepo $ unannexed ingitfile unannexed ingitfile -test_move :: TestEnv -> Assertion -test_move testenv = intmpclonerepo testenv $ do +test_move :: Assertion +test_move = intmpclonerepo $ do annexed_notpresent annexedfile - inmainrepo testenv $ annexed_present annexedfile - git_annex testenv "move" ["--from", "origin", annexedfile] @? "move --from of file failed" + inmainrepo $ annexed_present annexedfile + git_annex "move" ["--from", "origin", annexedfile] @? "move --from of file failed" annexed_present annexedfile - inmainrepo testenv $ annexed_notpresent annexedfile - git_annex testenv "move" ["--from", "origin", annexedfile] @? "move --from of file already here failed" + inmainrepo $ annexed_notpresent annexedfile + git_annex "move" ["--from", "origin", annexedfile] @? "move --from of file already here failed" annexed_present annexedfile - inmainrepo testenv $ annexed_notpresent annexedfile - git_annex testenv "move" ["--to", "origin", annexedfile] @? "move --to of file failed" - inmainrepo testenv $ annexed_present annexedfile + inmainrepo $ annexed_notpresent annexedfile + git_annex "move" ["--to", "origin", annexedfile] @? "move --to of file failed" + inmainrepo $ annexed_present annexedfile annexed_notpresent annexedfile - git_annex testenv "move" ["--to", "origin", annexedfile] @? "move --to of file already there failed" - inmainrepo testenv $ annexed_present annexedfile + git_annex "move" ["--to", "origin", annexedfile] @? "move --to of file already there failed" + inmainrepo $ annexed_present annexedfile annexed_notpresent annexedfile unlessM (annexeval Config.isDirect) $ do unannexed ingitfile - inmainrepo testenv $ unannexed ingitfile - git_annex testenv "move" ["--to", "origin", ingitfile] @? "move of ingitfile should be no-op" + inmainrepo $ unannexed ingitfile + git_annex "move" ["--to", "origin", ingitfile] @? "move of ingitfile should be no-op" unannexed ingitfile - inmainrepo testenv $ unannexed ingitfile - git_annex testenv "move" ["--from", "origin", ingitfile] @? "move of ingitfile should be no-op" + inmainrepo $ unannexed ingitfile + git_annex "move" ["--from", "origin", ingitfile] @? "move of ingitfile should be no-op" unannexed ingitfile - inmainrepo testenv $ unannexed ingitfile + inmainrepo $ unannexed ingitfile -test_copy :: TestEnv -> Assertion -test_copy testenv = intmpclonerepo testenv $ do +test_copy :: Assertion +test_copy = intmpclonerepo $ do annexed_notpresent annexedfile - inmainrepo testenv $ annexed_present annexedfile - git_annex testenv "copy" ["--from", "origin", annexedfile] @? "copy --from of file failed" + inmainrepo $ annexed_present annexedfile + git_annex "copy" ["--from", "origin", annexedfile] @? "copy --from of file failed" annexed_present annexedfile - inmainrepo testenv $ annexed_present annexedfile - git_annex testenv "copy" ["--from", "origin", annexedfile] @? "copy --from of file already here failed" + inmainrepo $ annexed_present annexedfile + git_annex "copy" ["--from", "origin", annexedfile] @? "copy --from of file already here failed" annexed_present annexedfile - inmainrepo testenv $ annexed_present annexedfile - git_annex testenv "copy" ["--to", "origin", annexedfile] @? "copy --to of file already there failed" + inmainrepo $ annexed_present annexedfile + git_annex "copy" ["--to", "origin", annexedfile] @? "copy --to of file already there failed" annexed_present annexedfile - inmainrepo testenv $ annexed_present annexedfile - git_annex testenv "move" ["--to", "origin", annexedfile] @? "move --to of file already there failed" + inmainrepo $ annexed_present annexedfile + git_annex "move" ["--to", "origin", annexedfile] @? "move --to of file already there failed" annexed_notpresent annexedfile - inmainrepo testenv $ annexed_present annexedfile + inmainrepo $ annexed_present annexedfile unlessM (annexeval Config.isDirect) $ do unannexed ingitfile - inmainrepo testenv $ unannexed ingitfile - git_annex testenv "copy" ["--to", "origin", ingitfile] @? "copy of ingitfile should be no-op" + inmainrepo $ unannexed ingitfile + git_annex "copy" ["--to", "origin", ingitfile] @? "copy of ingitfile should be no-op" unannexed ingitfile - inmainrepo testenv $ unannexed ingitfile - git_annex testenv "copy" ["--from", "origin", ingitfile] @? "copy of ingitfile should be no-op" + inmainrepo $ unannexed ingitfile + git_annex "copy" ["--from", "origin", ingitfile] @? "copy of ingitfile should be no-op" checkregularfile ingitfile checkcontent ingitfile -test_preferred_content :: TestEnv -> Assertion -test_preferred_content testenv = intmpclonerepo testenv $ do +test_preferred_content :: Assertion +test_preferred_content = intmpclonerepo $ 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 testenv "get" ["--auto", annexedfile] @? "get --auto of file failed with default preferred content" + git_annex "get" ["--auto", annexedfile] @? "get --auto of file failed with default preferred content" annexed_notpresent annexedfile - git_annex testenv "wanted" [".", "standard"] @? "set expression to standard failed" - git_annex testenv "group" [".", "client"] @? "set group to standard failed" - git_annex testenv "get" ["--auto", annexedfile] @? "get --auto of file failed for client" + git_annex "wanted" [".", "standard"] @? "set expression to standard failed" + git_annex "group" [".", "client"] @? "set group to standard failed" + git_annex "get" ["--auto", annexedfile] @? "get --auto of file failed for client" annexed_present annexedfile - git_annex testenv "ungroup" [".", "client"] @? "ungroup failed" + git_annex "ungroup" [".", "client"] @? "ungroup failed" - git_annex testenv "wanted" [".", "standard"] @? "set expression to standard failed" - git_annex testenv "group" [".", "manual"] @? "set group to manual failed" + git_annex "wanted" [".", "standard"] @? "set expression to standard failed" + git_annex "group" [".", "manual"] @? "set group to manual failed" -- drop --auto with manual leaves the file where it is - git_annex testenv "drop" ["--auto", annexedfile] @? "drop --auto of file failed with manual preferred content" + git_annex "drop" ["--auto", annexedfile] @? "drop --auto of file failed with manual preferred content" annexed_present annexedfile - git_annex testenv "drop" [annexedfile] @? "drop of file failed" + git_annex "drop" [annexedfile] @? "drop of file failed" annexed_notpresent annexedfile -- get --auto with manual does not get the file - git_annex testenv "get" ["--auto", annexedfile] @? "get --auto of file failed with manual preferred content" + git_annex "get" ["--auto", annexedfile] @? "get --auto of file failed with manual preferred content" annexed_notpresent annexedfile - git_annex testenv "ungroup" [".", "client"] @? "ungroup failed" + git_annex "ungroup" [".", "client"] @? "ungroup failed" - git_annex testenv "wanted" [".", "exclude=*"] @? "set expression to exclude=* failed" - git_annex testenv "get" [annexedfile] @? "get of file failed" + git_annex "wanted" [".", "exclude=*"] @? "set expression to exclude=* failed" + git_annex "get" [annexedfile] @? "get of file failed" annexed_present annexedfile - git_annex testenv "drop" ["--auto", annexedfile] @? "drop --auto of file failed with exclude=*" + git_annex "drop" ["--auto", annexedfile] @? "drop --auto of file failed with exclude=*" annexed_notpresent annexedfile - git_annex testenv "get" ["--auto", annexedfile] @? "get --auto of file failed with exclude=*" + git_annex "get" ["--auto", annexedfile] @? "get --auto of file failed with exclude=*" annexed_notpresent annexedfile -test_lock :: TestEnv -> Assertion -test_lock testenv = intmpclonerepoInDirect testenv $ do +test_lock :: Assertion +test_lock = intmpclonerepoInDirect $ do -- regression test: unlock of not present file should skip it annexed_notpresent annexedfile - not <$> git_annex testenv "unlock" [annexedfile] @? "unlock failed to fail with not present file" + not <$> git_annex "unlock" [annexedfile] @? "unlock failed to fail with not present file" annexed_notpresent annexedfile - git_annex testenv "get" [annexedfile] @? "get of file failed" + git_annex "get" [annexedfile] @? "get of file failed" annexed_present annexedfile - git_annex testenv "unlock" [annexedfile] @? "unlock failed" + git_annex "unlock" [annexedfile] @? "unlock failed" unannexed annexedfile -- write different content, to verify that lock -- throws it away changecontent annexedfile writeFile annexedfile $ content annexedfile ++ "foo" - not <$> git_annex testenv "lock" [annexedfile] @? "lock failed to fail without --force" - git_annex testenv "lock" ["--force", annexedfile] @? "lock --force failed" + not <$> git_annex "lock" [annexedfile] @? "lock failed to fail without --force" + git_annex "lock" ["--force", annexedfile] @? "lock --force failed" annexed_present annexedfile - git_annex testenv "unlock" [annexedfile] @? "unlock failed" + git_annex "unlock" [annexedfile] @? "unlock failed" unannexed annexedfile changecontent annexedfile - git_annex testenv "add" [annexedfile] @? "add of modified file failed" + git_annex "add" [annexedfile] @? "add of modified file failed" runchecks [checklink, checkunwritable] annexedfile c <- readFile annexedfile assertEqual "content of modified file" c (changedcontent annexedfile) - r' <- git_annex testenv "drop" [annexedfile] + r' <- git_annex "drop" [annexedfile] not r' @? "drop wrongly succeeded with no known copy of modified file" -test_edit :: TestEnv -> Assertion +test_edit :: Assertion test_edit = test_edit' False -test_edit_precommit :: TestEnv -> Assertion +test_edit_precommit :: Assertion test_edit_precommit = test_edit' True -test_edit' :: Bool -> TestEnv -> Assertion -test_edit' precommit testenv = intmpclonerepoInDirect testenv $ do - git_annex testenv "get" [annexedfile] @? "get of file failed" +test_edit' :: Bool -> Assertion +test_edit' precommit = intmpclonerepoInDirect $ do + git_annex "get" [annexedfile] @? "get of file failed" annexed_present annexedfile - git_annex testenv "edit" [annexedfile] @? "edit failed" + git_annex "edit" [annexedfile] @? "edit failed" unannexed annexedfile changecontent annexedfile boolSystem "git" [Param "add", File annexedfile] @? "git add of edited file failed" if precommit - then git_annex testenv "pre-commit" [] + then git_annex "pre-commit" [] @? "pre-commit failed" else boolSystem "git" [Params "commit -q -m contentchanged"] @? "git commit of edited file failed" runchecks [checklink, checkunwritable] annexedfile c <- readFile annexedfile assertEqual "content of modified file" c (changedcontent annexedfile) - not <$> git_annex testenv "drop" [annexedfile] @? "drop wrongly succeeded with no known copy of modified file" + not <$> git_annex "drop" [annexedfile] @? "drop wrongly succeeded with no known copy of modified file" -test_partial_commit :: TestEnv -> Assertion -test_partial_commit testenv = intmpclonerepoInDirect testenv $ do - git_annex testenv "get" [annexedfile] @? "get of file failed" +test_partial_commit :: Assertion +test_partial_commit = intmpclonerepoInDirect $ do + git_annex "get" [annexedfile] @? "get of file failed" annexed_present annexedfile - git_annex testenv "unlock" [annexedfile] @? "unlock failed" + git_annex "unlock" [annexedfile] @? "unlock failed" not <$> boolSystem "git" [Params "commit -q -m test", File annexedfile] @? "partial commit of unlocked file not blocked by pre-commit hook" -test_fix :: TestEnv -> Assertion -test_fix testenv = intmpclonerepoInDirect testenv $ do +test_fix :: Assertion +test_fix = intmpclonerepoInDirect $ do annexed_notpresent annexedfile - git_annex testenv "fix" [annexedfile] @? "fix of not present failed" + git_annex "fix" [annexedfile] @? "fix of not present failed" annexed_notpresent annexedfile - git_annex testenv "get" [annexedfile] @? "get of file failed" + git_annex "get" [annexedfile] @? "get of file failed" annexed_present annexedfile - git_annex testenv "fix" [annexedfile] @? "fix of present file failed" + git_annex "fix" [annexedfile] @? "fix of present file failed" annexed_present annexedfile createDirectory subdir boolSystem "git" [Param "mv", File annexedfile, File subdir] @? "git mv failed" - git_annex testenv "fix" [newfile] @? "fix of moved file failed" + git_annex "fix" [newfile] @? "fix of moved file failed" runchecks [checklink, checkunwritable] newfile c <- readFile newfile assertEqual "content of moved file" c (content annexedfile) @@ -530,23 +524,23 @@ test_fix testenv = intmpclonerepoInDirect testenv $ do subdir = "s" newfile = subdir ++ "/" ++ annexedfile -test_trust :: TestEnv -> Assertion -test_trust testenv = intmpclonerepo testenv $ do - git_annex testenv "trust" [repo] @? "trust failed" +test_trust :: Assertion +test_trust = intmpclonerepo $ do + git_annex "trust" [repo] @? "trust failed" trustcheck Logs.Trust.Trusted "trusted 1" - git_annex testenv "trust" [repo] @? "trust of trusted failed" + git_annex "trust" [repo] @? "trust of trusted failed" trustcheck Logs.Trust.Trusted "trusted 2" - git_annex testenv "untrust" [repo] @? "untrust failed" + git_annex "untrust" [repo] @? "untrust failed" trustcheck Logs.Trust.UnTrusted "untrusted 1" - git_annex testenv "untrust" [repo] @? "untrust of untrusted failed" + git_annex "untrust" [repo] @? "untrust of untrusted failed" trustcheck Logs.Trust.UnTrusted "untrusted 2" - git_annex testenv "dead" [repo] @? "dead failed" + git_annex "dead" [repo] @? "dead failed" trustcheck Logs.Trust.DeadTrusted "deadtrusted 1" - git_annex testenv "dead" [repo] @? "dead of dead failed" + git_annex "dead" [repo] @? "dead of dead failed" trustcheck Logs.Trust.DeadTrusted "deadtrusted 2" - git_annex testenv "semitrust" [repo] @? "semitrust failed" + git_annex "semitrust" [repo] @? "semitrust failed" trustcheck Logs.Trust.SemiTrusted "semitrusted 1" - git_annex testenv "semitrust" [repo] @? "semitrust of semitrusted failed" + git_annex "semitrust" [repo] @? "semitrust of semitrusted failed" trustcheck Logs.Trust.SemiTrusted "semitrusted 2" where repo = "origin" @@ -557,78 +551,78 @@ test_trust testenv = intmpclonerepo testenv $ do return $ u `elem` l assertBool msg present -test_fsck_basic :: TestEnv -> Assertion -test_fsck_basic testenv = intmpclonerepo testenv $ do - git_annex testenv "fsck" [] @? "fsck failed" - git_annex testenv "numcopies" ["2"] @? "numcopies config failed" - fsck_should_fail testenv "numcopies unsatisfied" - git_annex testenv "numcopies" ["1"] @? "numcopies config failed" +test_fsck_basic :: Assertion +test_fsck_basic = intmpclonerepo $ do + git_annex "fsck" [] @? "fsck failed" + git_annex "numcopies" ["2"] @? "numcopies config failed" + fsck_should_fail "numcopies unsatisfied" + git_annex "numcopies" ["1"] @? "numcopies config failed" corrupt annexedfile corrupt sha1annexedfile where corrupt f = do - git_annex testenv "get" [f] @? "get of file failed" + git_annex "get" [f] @? "get of file failed" Utility.FileMode.allowWrite f writeFile f (changedcontent f) ifM (annexeval Config.isDirect) - ( git_annex testenv "fsck" [] @? "fsck failed in direct mode with changed file content" - , not <$> git_annex testenv "fsck" [] @? "fsck failed to fail with corrupted file content" + ( git_annex "fsck" [] @? "fsck failed in direct mode with changed file content" + , not <$> git_annex "fsck" [] @? "fsck failed to fail with corrupted file content" ) - git_annex testenv "fsck" [] @? "fsck unexpectedly failed again; previous one did not fix problem with " ++ f - -test_fsck_bare :: TestEnv -> Assertion -test_fsck_bare testenv = intmpbareclonerepo testenv $ - git_annex testenv "fsck" [] @? "fsck failed" - -test_fsck_localuntrusted :: TestEnv -> Assertion -test_fsck_localuntrusted testenv = intmpclonerepo testenv $ do - git_annex testenv "get" [annexedfile] @? "get failed" - git_annex testenv "untrust" ["origin"] @? "untrust of origin repo failed" - git_annex testenv "untrust" ["."] @? "untrust of current repo failed" - fsck_should_fail testenv "content only available in untrusted (current) repository" - git_annex testenv "trust" ["."] @? "trust of current repo failed" - git_annex testenv "fsck" [annexedfile] @? "fsck failed on file present in trusted repo" - -test_fsck_remoteuntrusted :: TestEnv -> Assertion -test_fsck_remoteuntrusted testenv = intmpclonerepo testenv $ do - git_annex testenv "numcopies" ["2"] @? "numcopies config failed" - git_annex testenv "get" [annexedfile] @? "get failed" - git_annex testenv "get" [sha1annexedfile] @? "get failed" - git_annex testenv "fsck" [] @? "fsck failed with numcopies=2 and 2 copies" - git_annex testenv "untrust" ["origin"] @? "untrust of origin failed" - fsck_should_fail testenv "content not replicated to enough non-untrusted repositories" - -fsck_should_fail :: TestEnv -> String -> Assertion -fsck_should_fail testenv m = not <$> git_annex testenv "fsck" [] + git_annex "fsck" [] @? "fsck unexpectedly failed again; previous one did not fix problem with " ++ f + +test_fsck_bare :: Assertion +test_fsck_bare = intmpbareclonerepo $ + git_annex "fsck" [] @? "fsck failed" + +test_fsck_localuntrusted :: Assertion +test_fsck_localuntrusted = intmpclonerepo $ do + git_annex "get" [annexedfile] @? "get failed" + git_annex "untrust" ["origin"] @? "untrust of origin repo failed" + git_annex "untrust" ["."] @? "untrust of current repo failed" + fsck_should_fail "content only available in untrusted (current) repository" + git_annex "trust" ["."] @? "trust of current repo failed" + git_annex "fsck" [annexedfile] @? "fsck failed on file present in trusted repo" + +test_fsck_remoteuntrusted :: Assertion +test_fsck_remoteuntrusted = intmpclonerepo $ do + git_annex "numcopies" ["2"] @? "numcopies config failed" + git_annex "get" [annexedfile] @? "get failed" + git_annex "get" [sha1annexedfile] @? "get failed" + git_annex "fsck" [] @? "fsck failed with numcopies=2 and 2 copies" + git_annex "untrust" ["origin"] @? "untrust of origin failed" + fsck_should_fail "content not replicated to enough non-untrusted repositories" + +fsck_should_fail :: String -> Assertion +fsck_should_fail m = not <$> git_annex "fsck" [] @? "fsck failed to fail with " ++ m -test_migrate :: TestEnv -> Assertion +test_migrate :: Assertion test_migrate = test_migrate' False -test_migrate_via_gitattributes :: TestEnv -> Assertion +test_migrate_via_gitattributes :: Assertion test_migrate_via_gitattributes = test_migrate' True -test_migrate' :: Bool -> TestEnv -> Assertion -test_migrate' usegitattributes testenv = intmpclonerepoInDirect testenv $ do +test_migrate' :: Bool -> Assertion +test_migrate' usegitattributes = intmpclonerepoInDirect $ do annexed_notpresent annexedfile annexed_notpresent sha1annexedfile - git_annex testenv "migrate" [annexedfile] @? "migrate of not present failed" - git_annex testenv "migrate" [sha1annexedfile] @? "migrate of not present failed" - git_annex testenv "get" [annexedfile] @? "get of file failed" - git_annex testenv "get" [sha1annexedfile] @? "get of file failed" + git_annex "migrate" [annexedfile] @? "migrate of not present failed" + git_annex "migrate" [sha1annexedfile] @? "migrate of not present failed" + git_annex "get" [annexedfile] @? "get of file failed" + git_annex "get" [sha1annexedfile] @? "get of file failed" annexed_present annexedfile annexed_present sha1annexedfile if usegitattributes then do writeFile ".gitattributes" "* annex.backend=SHA1" - git_annex testenv "migrate" [sha1annexedfile] + git_annex "migrate" [sha1annexedfile] @? "migrate sha1annexedfile failed" - git_annex testenv "migrate" [annexedfile] + git_annex "migrate" [annexedfile] @? "migrate annexedfile failed" else do - git_annex testenv "migrate" [sha1annexedfile, "--backend", "SHA1"] + git_annex "migrate" [sha1annexedfile, "--backend", "SHA1"] @? "migrate sha1annexedfile failed" - git_annex testenv "migrate" [annexedfile, "--backend", "SHA1"] + git_annex "migrate" [annexedfile, "--backend", "SHA1"] @? "migrate annexedfile failed" annexed_present annexedfile annexed_present sha1annexedfile @@ -637,23 +631,23 @@ test_migrate' usegitattributes testenv = intmpclonerepoInDirect testenv $ do -- check that reversing a migration works writeFile ".gitattributes" "* annex.backend=SHA256" - git_annex testenv "migrate" [sha1annexedfile] + git_annex "migrate" [sha1annexedfile] @? "migrate sha1annexedfile failed" - git_annex testenv "migrate" [annexedfile] + git_annex "migrate" [annexedfile] @? "migrate annexedfile failed" annexed_present annexedfile annexed_present sha1annexedfile checkbackend annexedfile backendSHA256 checkbackend sha1annexedfile backendSHA256 -test_unused :: TestEnv -> Assertion +test_unused :: Assertion -- This test is broken in direct mode -test_unused testenv = intmpclonerepoInDirect testenv $ do +test_unused = intmpclonerepoInDirect $ do -- keys have to be looked up before files are removed annexedfilekey <- annexeval $ findkey annexedfile sha1annexedfilekey <- annexeval $ findkey sha1annexedfile - git_annex testenv "get" [annexedfile] @? "get of file failed" - git_annex testenv "get" [sha1annexedfile] @? "get of file failed" + git_annex "get" [annexedfile] @? "get of file failed" + git_annex "get" [sha1annexedfile] @? "get of file failed" checkunused [] "after get" boolSystem "git" [Params "rm -fq", File annexedfile] @? "git rm failed" checkunused [] "after rm" @@ -667,19 +661,19 @@ test_unused testenv = intmpclonerepoInDirect testenv $ do checkunused [annexedfilekey, sha1annexedfilekey] "after rm sha1annexedfile" -- good opportunity to test dropkey also - git_annex testenv "dropkey" ["--force", Types.Key.key2file annexedfilekey] + git_annex "dropkey" ["--force", Types.Key.key2file annexedfilekey] @? "dropkey failed" checkunused [sha1annexedfilekey] ("after dropkey --force " ++ Types.Key.key2file annexedfilekey) - not <$> git_annex testenv "dropunused" ["1"] @? "dropunused failed to fail without --force" - git_annex testenv "dropunused" ["--force", "1"] @? "dropunused failed" + not <$> git_annex "dropunused" ["1"] @? "dropunused failed to fail without --force" + git_annex "dropunused" ["--force", "1"] @? "dropunused failed" checkunused [] "after dropunused" - not <$> git_annex testenv "dropunused" ["--force", "10", "501"] @? "dropunused failed to fail on bogus numbers" + not <$> git_annex "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 testenv "add" ["unusedfile"] @? "add of unusedfile failed" + git_annex "add" ["unusedfile"] @? "add of unusedfile failed" unusedfilekey <- annexeval $ findkey "unusedfile" renameFile "unusedfile" "unusedunstagedfile" boolSystem "git" [Params "rm -qf", File "unusedfile"] @? "git rm failed" @@ -690,7 +684,7 @@ test_unused testenv = intmpclonerepoInDirect testenv $ do -- unused used to miss symlinks that were deleted or modified -- manually, but commited as such. writeFile "unusedfile" "unusedcontent" - git_annex testenv "add" ["unusedfile"] @? "add of unusedfile failed" + git_annex "add" ["unusedfile"] @? "add of unusedfile failed" boolSystem "git" [Param "add", File "unusedfile"] @? "git add failed" unusedfilekey' <- annexeval $ findkey "unusedfile" checkunused [] "with staged deleted link" @@ -700,7 +694,7 @@ test_unused testenv = intmpclonerepoInDirect testenv $ do -- unused used to miss symlinks that were deleted or modified -- manually, but not staged as such. writeFile "unusedfile" "unusedcontent" - git_annex testenv "add" ["unusedfile"] @? "add of unusedfile failed" + git_annex "add" ["unusedfile"] @? "add of unusedfile failed" boolSystem "git" [Param "add", File "unusedfile"] @? "git add failed" unusedfilekey'' <- annexeval $ findkey "unusedfile" checkunused [] "with unstaged deleted link" @@ -709,7 +703,7 @@ test_unused testenv = intmpclonerepoInDirect testenv $ do where checkunused expectedkeys desc = do - git_annex testenv "unused" [] @? "unused failed" + git_annex "unused" [] @? "unused failed" unusedmap <- annexeval $ Logs.Unused.readUnusedMap "" let unusedkeys = M.elems unusedmap assertEqual ("unused keys differ " ++ desc) @@ -718,110 +712,110 @@ test_unused testenv = intmpclonerepoInDirect testenv $ do r <- Backend.lookupFile f return $ fromJust r -test_describe :: TestEnv -> Assertion -test_describe testenv = intmpclonerepo testenv $ do - git_annex testenv "describe" [".", "this repo"] @? "describe 1 failed" - git_annex testenv "describe" ["origin", "origin repo"] @? "describe 2 failed" +test_describe :: Assertion +test_describe = intmpclonerepo $ do + git_annex "describe" [".", "this repo"] @? "describe 1 failed" + git_annex "describe" ["origin", "origin repo"] @? "describe 2 failed" -test_find :: TestEnv -> Assertion -test_find testenv = intmpclonerepo testenv $ do +test_find :: Assertion +test_find = intmpclonerepo $ do annexed_notpresent annexedfile - git_annex_expectoutput testenv "find" [] [] - git_annex testenv "get" [annexedfile] @? "get failed" + git_annex_expectoutput "find" [] [] + git_annex "get" [annexedfile] @? "get failed" annexed_present annexedfile annexed_notpresent sha1annexedfile - git_annex_expectoutput testenv "find" [] [annexedfile] - git_annex_expectoutput testenv "find" ["--exclude", annexedfile, "--and", "--exclude", sha1annexedfile] [] - git_annex_expectoutput testenv "find" ["--include", annexedfile] [annexedfile] - git_annex_expectoutput testenv "find" ["--not", "--in", "origin"] [] - git_annex_expectoutput testenv "find" ["--copies", "1", "--and", "--not", "--copies", "2"] [sha1annexedfile] - git_annex_expectoutput testenv "find" ["--inbackend", "SHA1"] [sha1annexedfile] - git_annex_expectoutput testenv "find" ["--inbackend", "WORM"] [] + git_annex_expectoutput "find" [] [annexedfile] + git_annex_expectoutput "find" ["--exclude", annexedfile, "--and", "--exclude", sha1annexedfile] [] + git_annex_expectoutput "find" ["--include", annexedfile] [annexedfile] + git_annex_expectoutput "find" ["--not", "--in", "origin"] [] + git_annex_expectoutput "find" ["--copies", "1", "--and", "--not", "--copies", "2"] [sha1annexedfile] + git_annex_expectoutput "find" ["--inbackend", "SHA1"] [sha1annexedfile] + git_annex_expectoutput "find" ["--inbackend", "WORM"] [] {- --include=* should match files in subdirectories too, - and --exclude=* should exclude them. -} createDirectory "dir" writeFile "dir/subfile" "subfile" - git_annex testenv "add" ["dir"] @? "add of subdir failed" - git_annex_expectoutput testenv "find" ["--include", "*", "--exclude", annexedfile, "--exclude", sha1annexedfile] ["dir/subfile"] - git_annex_expectoutput testenv "find" ["--exclude", "*"] [] + git_annex "add" ["dir"] @? "add of subdir failed" + git_annex_expectoutput "find" ["--include", "*", "--exclude", annexedfile, "--exclude", sha1annexedfile] ["dir/subfile"] + git_annex_expectoutput "find" ["--exclude", "*"] [] -test_merge :: TestEnv -> Assertion -test_merge testenv = intmpclonerepo testenv $ - git_annex testenv "merge" [] @? "merge failed" +test_merge :: Assertion +test_merge = intmpclonerepo $ + git_annex "merge" [] @? "merge failed" -test_info :: TestEnv -> Assertion -test_info testenv = intmpclonerepo testenv $ do - json <- git_annex_output testenv "info" ["--json"] +test_info :: Assertion +test_info = intmpclonerepo $ do + json <- git_annex_output "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 -> Assertion -test_version testenv = intmpclonerepo testenv $ - git_annex testenv "version" [] @? "version failed" +test_version :: Assertion +test_version = intmpclonerepo $ + git_annex "version" [] @? "version failed" -test_sync :: TestEnv -> Assertion -test_sync testenv = intmpclonerepo testenv $ do - git_annex testenv "sync" [] @? "sync failed" +test_sync :: Assertion +test_sync = intmpclonerepo $ do + git_annex "sync" [] @? "sync failed" {- Regression test for bug fixed in - 7b0970b340d7faeb745c666146c7f701ec71808f, where in direct mode - sync committed the symlink standin file to the annex. -} - git_annex_expectoutput testenv "find" ["--in", "."] [] + git_annex_expectoutput "find" ["--in", "."] [] {- Regression test for union merge bug fixed in - 0214e0fb175a608a49b812d81b4632c081f63027 -} -test_union_merge_regression :: TestEnv -> Assertion -test_union_merge_regression testenv = +test_union_merge_regression :: Assertion +test_union_merge_regression = {- We need 3 repos to see this bug. -} - withtmpclonerepo testenv False $ \r1 -> - withtmpclonerepo testenv False $ \r2 -> - withtmpclonerepo testenv False $ \r3 -> do - forM_ [r1, r2, r3] $ \r -> indir testenv r $ do + withtmpclonerepo False $ \r1 -> + withtmpclonerepo False $ \r2 -> + withtmpclonerepo False $ \r3 -> do + forM_ [r1, r2, r3] $ \r -> indir r $ do when (r /= r1) $ boolSystem "git" [Params "remote add r1", File ("../../" ++ r1)] @? "remote add" when (r /= r2) $ boolSystem "git" [Params "remote add r2", File ("../../" ++ r2)] @? "remote add" when (r /= r3) $ boolSystem "git" [Params "remote add r3", File ("../../" ++ r3)] @? "remote add" - git_annex testenv "get" [annexedfile] @? "get failed" + git_annex "get" [annexedfile] @? "get failed" boolSystem "git" [Params "remote rm origin"] @? "remote rm" - forM_ [r3, r2, r1] $ \r -> indir testenv r $ - git_annex testenv "sync" [] @? "sync failed" - forM_ [r3, r2] $ \r -> indir testenv r $ - git_annex testenv "drop" ["--force", annexedfile] @? "drop failed" - indir testenv r1 $ do - git_annex testenv "sync" [] @? "sync failed in r1" - git_annex_expectoutput testenv "find" ["--in", "r3"] [] + forM_ [r3, r2, r1] $ \r -> indir r $ + git_annex "sync" [] @? "sync failed" + forM_ [r3, r2] $ \r -> indir r $ + git_annex "drop" ["--force", annexedfile] @? "drop failed" + indir r1 $ do + git_annex "sync" [] @? "sync failed in r1" + git_annex_expectoutput "find" ["--in", "r3"] [] {- This was the bug. The sync - mangled location log data and it - thought the file was still in r2 -} - git_annex_expectoutput testenv "find" ["--in", "r2"] [] + git_annex_expectoutput "find" ["--in", "r2"] [] {- Regression test for the automatic conflict resolution bug fixed - in f4ba19f2b8a76a1676da7bb5850baa40d9c388e2. -} -test_conflict_resolution_movein_regression :: TestEnv -> Assertion -test_conflict_resolution_movein_regression testenv = withtmpclonerepo testenv False $ \r1 -> - withtmpclonerepo testenv False $ \r2 -> do +test_conflict_resolution_movein_regression :: Assertion +test_conflict_resolution_movein_regression = withtmpclonerepo False $ \r1 -> + withtmpclonerepo False $ \r2 -> do let rname r = if r == r1 then "r1" else "r2" - forM_ [r1, r2] $ \r -> indir testenv r $ do + forM_ [r1, r2] $ \r -> indir r $ do {- Get all files, see check below. -} - git_annex testenv "get" [] @? "get failed" + git_annex "get" [] @? "get failed" disconnectOrigin - pair testenv r1 r2 - forM_ [r1, r2] $ \r -> indir testenv r $ do + pair r1 r2 + forM_ [r1, r2] $ \r -> indir r $ do {- Set up a conflict. -} let newcontent = content annexedfile ++ rname r ifM (annexeval Config.isDirect) ( writeFile annexedfile newcontent , do - git_annex testenv "unlock" [annexedfile] @? "unlock failed" + git_annex "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 testenv r $ - git_annex testenv "sync" ["--force"] @? "sync failed in " ++ rname r + forM_ [r1, r2, r1] $ \r -> indir r $ + git_annex "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. @@ -829,28 +823,28 @@ test_conflict_resolution_movein_regression testenv = withtmpclonerepo testenv Fa - 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 testenv r $ do - git_annex testenv "get" [] @? "unable to get all files after merge conflict resolution in " ++ rname r + forM_ [r1, r2] $ \r -> indir r $ do + git_annex "get" [] @? "unable to get all files after merge conflict resolution in " ++ rname r {- Simple case of conflict resolution; 2 different versions of annexed - file. -} -test_conflict_resolution :: TestEnv -> Assertion -test_conflict_resolution testenv = - withtmpclonerepo testenv False $ \r1 -> - withtmpclonerepo testenv False $ \r2 -> do - indir testenv r1 $ do +test_conflict_resolution :: Assertion +test_conflict_resolution = + withtmpclonerepo False $ \r1 -> + withtmpclonerepo False $ \r2 -> do + indir r1 $ do disconnectOrigin writeFile conflictor "conflictor1" - git_annex testenv "add" [conflictor] @? "add conflicter failed" - git_annex testenv "sync" [] @? "sync failed in r1" - indir testenv r2 $ do + git_annex "add" [conflictor] @? "add conflicter failed" + git_annex "sync" [] @? "sync failed in r1" + indir r2 $ do disconnectOrigin writeFile conflictor "conflictor2" - git_annex testenv "add" [conflictor] @? "add conflicter failed" - git_annex testenv "sync" [] @? "sync failed in r2" - pair testenv r1 r2 - forM_ [r1,r2,r1] $ \r -> indir testenv r $ - git_annex testenv "sync" [] @? "sync failed" + git_annex "add" [conflictor] @? "add conflicter failed" + git_annex "sync" [] @? "sync failed in r2" + pair r1 r2 + forM_ [r1,r2,r1] $ \r -> indir r $ + git_annex "sync" [] @? "sync failed" checkmerge "r1" r1 checkmerge "r2" r2 where @@ -862,35 +856,35 @@ test_conflict_resolution testenv = length v == 2 @? (what ++ " not exactly 2 variant files in: " ++ show l) conflictor `notElem` l @? ("conflictor still present after conflict resolution") - indir testenv d $ do - git_annex testenv "get" v @? "get failed" - git_annex_expectoutput testenv "find" v v + indir d $ do + git_annex "get" v @? "get failed" + git_annex_expectoutput "find" v v {- 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 testenv = do +test_mixed_conflict_resolution :: Assertion +test_mixed_conflict_resolution = do check True check False where - check inr1 = withtmpclonerepo testenv False $ \r1 -> - withtmpclonerepo testenv False $ \r2 -> do - indir testenv r1 $ do + check inr1 = withtmpclonerepo False $ \r1 -> + withtmpclonerepo False $ \r2 -> do + indir r1 $ do disconnectOrigin writeFile conflictor "conflictor" - git_annex testenv "add" [conflictor] @? "add conflicter failed" - git_annex testenv "sync" [] @? "sync failed in r1" - indir testenv r2 $ do + git_annex "add" [conflictor] @? "add conflicter failed" + git_annex "sync" [] @? "sync failed in r1" + indir r2 $ do disconnectOrigin createDirectory conflictor writeFile subfile "subfile" - git_annex testenv "add" [conflictor] @? "add conflicter failed" - git_annex testenv "sync" [] @? "sync failed in r2" - pair testenv r1 r2 + git_annex "add" [conflictor] @? "add conflicter failed" + git_annex "sync" [] @? "sync failed in r2" + pair r1 r2 let l = if inr1 then [r1, r2] else [r2, r1] - forM_ l $ \r -> indir testenv r $ - git_annex testenv "sync" [] @? "sync failed in mixed conflict" + forM_ l $ \r -> indir r $ + git_annex "sync" [] @? "sync failed in mixed conflict" checkmerge "r1" r1 checkmerge "r2" r2 conflictor = "conflictor" @@ -904,41 +898,41 @@ test_mixed_conflict_resolution testenv = do @? (what ++ " conflictor variant file missing in: " ++ show l ) length v == 1 @? (what ++ " too many variant files in: " ++ show v) - indir testenv d $ do - git_annex testenv "get" (conflictor:v) @? ("get failed in " ++ what) - git_annex_expectoutput testenv "find" [conflictor] [Git.FilePath.toInternalGitPath subfile] - git_annex_expectoutput testenv "find" v v + indir d $ do + git_annex "get" (conflictor:v) @? ("get failed in " ++ what) + git_annex_expectoutput "find" [conflictor] [Git.FilePath.toInternalGitPath subfile] + git_annex_expectoutput "find" v v {- Check merge conflict resolution when both repos start with an annexed - file; one modifies it, and the other deletes it. -} -test_remove_conflict_resolution :: TestEnv -> Assertion -test_remove_conflict_resolution testenv = do +test_remove_conflict_resolution :: Assertion +test_remove_conflict_resolution = do check True check False where - check inr1 = withtmpclonerepo testenv False $ \r1 -> - withtmpclonerepo testenv False $ \r2 -> do - indir testenv r1 $ do + check inr1 = withtmpclonerepo False $ \r1 -> + withtmpclonerepo False $ \r2 -> do + indir r1 $ do disconnectOrigin writeFile conflictor "conflictor" - git_annex testenv "add" [conflictor] @? "add conflicter failed" - git_annex testenv "sync" [] @? "sync failed in r1" - indir testenv r2 $ + git_annex "add" [conflictor] @? "add conflicter failed" + git_annex "sync" [] @? "sync failed in r1" + indir r2 $ disconnectOrigin - pair testenv r1 r2 - indir testenv r2 $ do - git_annex testenv "sync" [] @? "sync failed in r2" - git_annex testenv "get" [conflictor] + pair r1 r2 + indir r2 $ do + git_annex "sync" [] @? "sync failed in r2" + git_annex "get" [conflictor] @? "get conflictor failed" unlessM (annexeval Config.isDirect) $ do - git_annex testenv "unlock" [conflictor] + git_annex "unlock" [conflictor] @? "unlock conflictor failed" writeFile conflictor "newconflictor" - indir testenv r1 $ + indir r1 $ nukeFile conflictor let l = if inr1 then [r1, r2, r1] else [r2, r1, r2] - forM_ l $ \r -> indir testenv r $ - git_annex testenv "sync" [] @? "sync failed" + forM_ l $ \r -> indir r $ + git_annex "sync" [] @? "sync failed" checkmerge "r1" r1 checkmerge "r2" r2 conflictor = "conflictor" @@ -957,32 +951,32 @@ test_remove_conflict_resolution testenv = do - This test requires indirect mode to set it up, but tests both direct and - indirect mode. -} -test_nonannexed_file_conflict_resolution :: TestEnv -> Assertion -test_nonannexed_file_conflict_resolution testenv = do +test_nonannexed_file_conflict_resolution :: Assertion +test_nonannexed_file_conflict_resolution = do check True False check False False check True True check False True where - check inr1 switchdirect = withtmpclonerepo testenv False $ \r1 -> - withtmpclonerepo testenv False $ \r2 -> + check inr1 switchdirect = withtmpclonerepo False $ \r1 -> + withtmpclonerepo False $ \r2 -> whenM (isInDirect r1 <&&> isInDirect r2) $ do - indir testenv r1 $ do + indir r1 $ do disconnectOrigin writeFile conflictor "conflictor" - git_annex testenv "add" [conflictor] @? "add conflicter failed" - git_annex testenv "sync" [] @? "sync failed in r1" - indir testenv r2 $ do + git_annex "add" [conflictor] @? "add conflicter failed" + git_annex "sync" [] @? "sync failed in r1" + indir r2 $ do disconnectOrigin writeFile conflictor nonannexed_content boolSystem "git" [Params "add", File conflictor] @? "git add conflictor failed" - git_annex testenv "sync" [] @? "sync failed in r2" - pair testenv r1 r2 + git_annex "sync" [] @? "sync failed in r2" + pair r1 r2 let l = if inr1 then [r1, r2] else [r2, r1] - forM_ l $ \r -> indir testenv r $ do + forM_ l $ \r -> indir r $ do when switchdirect $ - git_annex testenv "direct" [] @? "failed switching to direct mode" - git_annex testenv "sync" [] @? "sync failed" + git_annex "direct" [] @? "failed switching to direct mode" + git_annex "sync" [] @? "sync failed" checkmerge ("r1" ++ show switchdirect) r1 checkmerge ("r2" ++ show switchdirect) r2 conflictor = "conflictor" @@ -1007,33 +1001,33 @@ test_nonannexed_file_conflict_resolution testenv = do - Test can only run when coreSymlinks is supported, because git needs to - be able to check out the non-git-annex symlink. -} -test_nonannexed_symlink_conflict_resolution :: TestEnv -> Assertion -test_nonannexed_symlink_conflict_resolution testenv = do +test_nonannexed_symlink_conflict_resolution :: Assertion +test_nonannexed_symlink_conflict_resolution = do check True False check False False check True True check False True where - check inr1 switchdirect = withtmpclonerepo testenv False $ \r1 -> - withtmpclonerepo testenv False $ \r2 -> + check inr1 switchdirect = withtmpclonerepo False $ \r1 -> + withtmpclonerepo False $ \r2 -> whenM (checkRepo (Types.coreSymlinks <$> Annex.getGitConfig) r1 <&&> isInDirect r1 <&&> isInDirect r2) $ do - indir testenv r1 $ do + indir r1 $ do disconnectOrigin writeFile conflictor "conflictor" - git_annex testenv "add" [conflictor] @? "add conflicter failed" - git_annex testenv "sync" [] @? "sync failed in r1" - indir testenv r2 $ do + git_annex "add" [conflictor] @? "add conflicter failed" + git_annex "sync" [] @? "sync failed in r1" + indir r2 $ do disconnectOrigin createSymbolicLink symlinktarget "conflictor" boolSystem "git" [Params "add", File conflictor] @? "git add conflictor failed" - git_annex testenv "sync" [] @? "sync failed in r2" - pair testenv r1 r2 + git_annex "sync" [] @? "sync failed in r2" + pair r1 r2 let l = if inr1 then [r1, r2] else [r2, r1] - forM_ l $ \r -> indir testenv r $ do + forM_ l $ \r -> indir r $ do when switchdirect $ - git_annex testenv "direct" [] @? "failed switching to direct mode" - git_annex testenv "sync" [] @? "sync failed" + git_annex "direct" [] @? "failed switching to direct mode" + git_annex "sync" [] @? "sync failed" checkmerge ("r1" ++ show switchdirect) r1 checkmerge ("r2" ++ show switchdirect) r2 conflictor = "conflictor" @@ -1060,38 +1054,38 @@ test_nonannexed_symlink_conflict_resolution testenv = do - - Case 2: Remote adds conflictor/file; local has a file named conflictor. -} -test_uncommitted_conflict_resolution :: TestEnv -> Assertion -test_uncommitted_conflict_resolution testenv = do +test_uncommitted_conflict_resolution :: Assertion +test_uncommitted_conflict_resolution = do check conflictor check (conflictor </> "file") where - check remoteconflictor = withtmpclonerepo testenv False $ \r1 -> - withtmpclonerepo testenv False $ \r2 -> do - indir testenv r1 $ do + check remoteconflictor = withtmpclonerepo False $ \r1 -> + withtmpclonerepo False $ \r2 -> do + indir r1 $ do disconnectOrigin createDirectoryIfMissing True (parentDir remoteconflictor) writeFile remoteconflictor annexedcontent - git_annex testenv "add" [conflictor] @? "add remoteconflicter failed" - git_annex testenv "sync" [] @? "sync failed in r1" - indir testenv r2 $ do + git_annex "add" [conflictor] @? "add remoteconflicter failed" + git_annex "sync" [] @? "sync failed in r1" + indir r2 $ do disconnectOrigin writeFile conflictor localcontent - pair testenv r1 r2 - indir testenv r2 $ ifM (annexeval Config.isDirect) + pair r1 r2 + indir r2 $ ifM (annexeval Config.isDirect) ( do - git_annex testenv "sync" [] @? "sync failed" + git_annex "sync" [] @? "sync failed" let local = conflictor ++ localprefix doesFileExist local @? (local ++ " missing after merge") s <- readFile local s == localcontent @? (local ++ " has wrong content: " ++ s) - git_annex testenv "get" [conflictor] @? "get failed" + git_annex "get" [conflictor] @? "get failed" doesFileExist remoteconflictor @? (remoteconflictor ++ " missing after merge") s' <- readFile remoteconflictor s' == annexedcontent @? (remoteconflictor ++ " has wrong content: " ++ s) -- this case is intentionally not handled -- in indirect mode, since the user -- can recover on their own easily - , not <$> git_annex testenv "sync" [] @? "sync failed to fail" + , not <$> git_annex "sync" [] @? "sync failed to fail" ) conflictor = "conflictor" localprefix = ".variant-local" @@ -1101,82 +1095,82 @@ test_uncommitted_conflict_resolution testenv = do {- On Windows/FAT, repeated conflict resolution sometimes - lost track of whether a file was a symlink. -} -test_conflict_resolution_symlink_bit :: TestEnv -> Assertion -test_conflict_resolution_symlink_bit testenv = - withtmpclonerepo testenv False $ \r1 -> - withtmpclonerepo testenv False $ \r2 -> - withtmpclonerepo testenv False $ \r3 -> do - indir testenv r1 $ do +test_conflict_resolution_symlink_bit :: Assertion +test_conflict_resolution_symlink_bit = + withtmpclonerepo False $ \r1 -> + withtmpclonerepo False $ \r2 -> + withtmpclonerepo False $ \r3 -> do + indir r1 $ do writeFile conflictor "conflictor" - git_annex testenv "add" [conflictor] @? "add conflicter failed" - git_annex testenv "sync" [] @? "sync failed in r1" + git_annex "add" [conflictor] @? "add conflicter failed" + git_annex "sync" [] @? "sync failed in r1" check_is_link conflictor "r1" - indir testenv r2 $ do + indir r2 $ do createDirectory conflictor writeFile (conflictor </> "subfile") "subfile" - git_annex testenv "add" [conflictor] @? "add conflicter failed" - git_annex testenv "sync" [] @? "sync failed in r2" + git_annex "add" [conflictor] @? "add conflicter failed" + git_annex "sync" [] @? "sync failed in r2" check_is_link (conflictor </> "subfile") "r2" - indir testenv r3 $ do + indir r3 $ do writeFile conflictor "conflictor" - git_annex testenv "add" [conflictor] @? "add conflicter failed" - git_annex testenv "sync" [] @? "sync failed in r1" + git_annex "add" [conflictor] @? "add conflicter failed" + git_annex "sync" [] @? "sync failed in r1" check_is_link (conflictor </> "subfile") "r3" where conflictor = "conflictor" check_is_link f what = do - git_annex_expectoutput testenv "find" ["--include=*", f] [Git.FilePath.toInternalGitPath f] + git_annex_expectoutput "find" ["--include=*", f] [Git.FilePath.toInternalGitPath f] l <- annexeval $ Annex.inRepo $ Git.LsTree.lsTreeFiles Git.Ref.headRef [f] all (\i -> Git.Types.toBlobType (Git.LsTree.mode i) == Just Git.Types.SymlinkBlob) l @? (what ++ " " ++ f ++ " lost symlink bit after merge: " ++ show l) {- Set up repos as remotes of each other. -} -pair :: TestEnv -> FilePath -> FilePath -> Assertion -pair testenv r1 r2 = forM_ [r1, r2] $ \r -> indir testenv r $ do +pair :: FilePath -> FilePath -> Assertion +pair r1 r2 = forM_ [r1, r2] $ \r -> indir 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" -test_map :: TestEnv -> Assertion -test_map testenv = intmpclonerepo testenv $ do +test_map :: Assertion +test_map = intmpclonerepo $ do -- set descriptions, that will be looked for in the map - git_annex testenv "describe" [".", "this repo"] @? "describe 1 failed" - git_annex testenv "describe" ["origin", "origin repo"] @? "describe 2 failed" + git_annex "describe" [".", "this repo"] @? "describe 1 failed" + git_annex "describe" ["origin", "origin repo"] @? "describe 2 failed" -- --fast avoids it running graphviz, not a build dependency - git_annex testenv "map" ["--fast"] @? "map failed" + git_annex "map" ["--fast"] @? "map failed" -test_uninit :: TestEnv -> Assertion -test_uninit testenv = intmpclonerepo testenv $ do - git_annex testenv "get" [] @? "get failed" +test_uninit :: Assertion +test_uninit = intmpclonerepo $ do + git_annex "get" [] @? "get failed" annexed_present annexedfile - _ <- git_annex testenv "uninit" [] -- exit status not checked; does abnormal exit + _ <- git_annex "uninit" [] -- exit status not checked; does abnormal exit checkregularfile annexedfile doesDirectoryExist ".git" @? ".git vanished in uninit" -test_uninit_inbranch :: TestEnv -> Assertion -test_uninit_inbranch testenv = intmpclonerepoInDirect testenv $ do +test_uninit_inbranch :: Assertion +test_uninit_inbranch = intmpclonerepoInDirect $ do boolSystem "git" [Params "checkout git-annex"] @? "git checkout git-annex" - not <$> git_annex testenv "uninit" [] @? "uninit failed to fail when git-annex branch was checked out" + not <$> git_annex "uninit" [] @? "uninit failed to fail when git-annex branch was checked out" -test_upgrade :: TestEnv -> Assertion -test_upgrade testenv = intmpclonerepo testenv $ - git_annex testenv "upgrade" [] @? "upgrade from same version failed" +test_upgrade :: Assertion +test_upgrade = intmpclonerepo $ + git_annex "upgrade" [] @? "upgrade from same version failed" -test_whereis :: TestEnv -> Assertion -test_whereis testenv = intmpclonerepo testenv $ do +test_whereis :: Assertion +test_whereis = intmpclonerepo $ do annexed_notpresent annexedfile - git_annex testenv "whereis" [annexedfile] @? "whereis on non-present file failed" - git_annex testenv "untrust" ["origin"] @? "untrust failed" - not <$> git_annex testenv "whereis" [annexedfile] @? "whereis on non-present file only present in untrusted repo failed to fail" - git_annex testenv "get" [annexedfile] @? "get failed" + git_annex "whereis" [annexedfile] @? "whereis on non-present file failed" + git_annex "untrust" ["origin"] @? "untrust failed" + not <$> git_annex "whereis" [annexedfile] @? "whereis on non-present file only present in untrusted repo failed to fail" + git_annex "get" [annexedfile] @? "get failed" annexed_present annexedfile - git_annex testenv "whereis" [annexedfile] @? "whereis on present file failed" + git_annex "whereis" [annexedfile] @? "whereis on present file failed" -test_hook_remote :: TestEnv -> Assertion -test_hook_remote testenv = intmpclonerepo testenv $ do +test_hook_remote :: Assertion +test_hook_remote = intmpclonerepo $ do #ifndef mingw32_HOST_OS - git_annex testenv "initremote" (words "foo type=hook encryption=none hooktype=foo") @? "initremote failed" + git_annex "initremote" (words "foo type=hook encryption=none hooktype=foo") @? "initremote failed" createDirectory dir git_config "annex.foo-store-hook" $ "cp $ANNEX_FILE " ++ loc @@ -1186,15 +1180,15 @@ test_hook_remote testenv = intmpclonerepo testenv $ do "rm -f " ++ loc git_config "annex.foo-checkpresent-hook" $ "if [ -e " ++ loc ++ " ]; then echo $ANNEX_KEY; fi" - git_annex testenv "get" [annexedfile] @? "get of file failed" + git_annex "get" [annexedfile] @? "get of file failed" annexed_present annexedfile - git_annex testenv "copy" [annexedfile, "--to", "foo"] @? "copy --to hook remote failed" + git_annex "copy" [annexedfile, "--to", "foo"] @? "copy --to hook remote failed" annexed_present annexedfile - git_annex testenv "drop" [annexedfile, "--numcopies=2"] @? "drop failed" + git_annex "drop" [annexedfile, "--numcopies=2"] @? "drop failed" annexed_notpresent annexedfile - git_annex testenv "move" [annexedfile, "--from", "foo"] @? "move --from hook remote failed" + git_annex "move" [annexedfile, "--from", "foo"] @? "move --from hook remote failed" annexed_present annexedfile - not <$> git_annex testenv "drop" [annexedfile, "--numcopies=2"] @? "drop failed to fail" + not <$> git_annex "drop" [annexedfile, "--numcopies=2"] @? "drop failed to fail" annexed_present annexedfile where dir = "dir" @@ -1206,65 +1200,65 @@ test_hook_remote testenv = intmpclonerepo testenv $ do noop #endif -test_directory_remote :: TestEnv -> Assertion -test_directory_remote testenv = intmpclonerepo testenv $ do +test_directory_remote :: Assertion +test_directory_remote = intmpclonerepo $ do createDirectory "dir" - git_annex testenv "initremote" (words "foo type=directory encryption=none directory=dir") @? "initremote failed" - git_annex testenv "get" [annexedfile] @? "get of file failed" + git_annex "initremote" (words "foo type=directory encryption=none directory=dir") @? "initremote failed" + git_annex "get" [annexedfile] @? "get of file failed" annexed_present annexedfile - git_annex testenv "copy" [annexedfile, "--to", "foo"] @? "copy --to directory remote failed" + git_annex "copy" [annexedfile, "--to", "foo"] @? "copy --to directory remote failed" annexed_present annexedfile - git_annex testenv "drop" [annexedfile, "--numcopies=2"] @? "drop failed" + git_annex "drop" [annexedfile, "--numcopies=2"] @? "drop failed" annexed_notpresent annexedfile - git_annex testenv "move" [annexedfile, "--from", "foo"] @? "move --from directory remote failed" + git_annex "move" [annexedfile, "--from", "foo"] @? "move --from directory remote failed" annexed_present annexedfile - not <$> git_annex testenv "drop" [annexedfile, "--numcopies=2"] @? "drop failed to fail" + not <$> git_annex "drop" [annexedfile, "--numcopies=2"] @? "drop failed to fail" annexed_present annexedfile -test_rsync_remote :: TestEnv -> Assertion -test_rsync_remote testenv = intmpclonerepo testenv $ do +test_rsync_remote :: Assertion +test_rsync_remote = intmpclonerepo $ do createDirectory "dir" - git_annex testenv "initremote" (words "foo type=rsync encryption=none rsyncurl=dir") @? "initremote failed" - git_annex testenv "get" [annexedfile] @? "get of file failed" + git_annex "initremote" (words "foo type=rsync encryption=none rsyncurl=dir") @? "initremote failed" + git_annex "get" [annexedfile] @? "get of file failed" annexed_present annexedfile - git_annex testenv "copy" [annexedfile, "--to", "foo"] @? "copy --to rsync remote failed" + git_annex "copy" [annexedfile, "--to", "foo"] @? "copy --to rsync remote failed" annexed_present annexedfile - git_annex testenv "drop" [annexedfile, "--numcopies=2"] @? "drop failed" + git_annex "drop" [annexedfile, "--numcopies=2"] @? "drop failed" annexed_notpresent annexedfile - git_annex testenv "move" [annexedfile, "--from", "foo"] @? "move --from rsync remote failed" + git_annex "move" [annexedfile, "--from", "foo"] @? "move --from rsync remote failed" annexed_present annexedfile - not <$> git_annex testenv "drop" [annexedfile, "--numcopies=2"] @? "drop failed to fail" + not <$> git_annex "drop" [annexedfile, "--numcopies=2"] @? "drop failed to fail" annexed_present annexedfile -test_bup_remote :: TestEnv -> Assertion -test_bup_remote testenv = intmpclonerepo testenv $ when Build.SysConfig.bup $ do +test_bup_remote :: Assertion +test_bup_remote = intmpclonerepo $ when Build.SysConfig.bup $ do dir <- absPath "dir" -- bup special remote needs an absolute path createDirectory dir - git_annex testenv "initremote" (words $ "foo type=bup encryption=none buprepo="++dir) @? "initremote failed" - git_annex testenv "get" [annexedfile] @? "get of file failed" + git_annex "initremote" (words $ "foo type=bup encryption=none buprepo="++dir) @? "initremote failed" + git_annex "get" [annexedfile] @? "get of file failed" annexed_present annexedfile - git_annex testenv "copy" [annexedfile, "--to", "foo"] @? "copy --to bup remote failed" + git_annex "copy" [annexedfile, "--to", "foo"] @? "copy --to bup remote failed" annexed_present annexedfile - git_annex testenv "drop" [annexedfile, "--numcopies=2"] @? "drop failed" + git_annex "drop" [annexedfile, "--numcopies=2"] @? "drop failed" annexed_notpresent annexedfile - git_annex testenv "copy" [annexedfile, "--from", "foo"] @? "copy --from bup remote failed" + git_annex "copy" [annexedfile, "--from", "foo"] @? "copy --from bup remote failed" annexed_present annexedfile - git_annex testenv "move" [annexedfile, "--from", "foo"] @? "move --from bup remote failed" + git_annex "move" [annexedfile, "--from", "foo"] @? "move --from bup remote failed" annexed_present annexedfile -- gpg is not a build dependency, so only test when it's available -test_crypto :: TestEnv -> Assertion +test_crypto :: Assertion #ifndef mingw32_HOST_OS -test_crypto testenv = do +test_crypto = do testscheme "shared" testscheme "hybrid" testscheme "pubkey" where - testscheme scheme = intmpclonerepo testenv $ whenM (Utility.Path.inPath Utility.Gpg.gpgcmd) $ do + testscheme scheme = intmpclonerepo $ 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 testenv cmd $ + let a cmd = git_annex cmd $ [ "foo" , "type=directory" , "encryption=" ++ scheme @@ -1277,9 +1271,9 @@ test_crypto testenv = do 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 testenv "get" [annexedfile] @? "get of file failed" + git_annex "get" [annexedfile] @? "get of file failed" annexed_present annexedfile - git_annex testenv "copy" [annexedfile, "--to", "foo"] @? "copy --to encrypted remote failed" + git_annex "copy" [annexedfile, "--to", "foo"] @? "copy --to encrypted remote failed" (c,k) <- annexeval $ do uuid <- Remote.nameToUUID "foo" rs <- Logs.Remote.readRemoteLog @@ -1291,11 +1285,11 @@ test_crypto testenv = do testEncryptedRemote scheme key c [k] @? "invalid crypto setup" annexed_present annexedfile - git_annex testenv "drop" [annexedfile, "--numcopies=2"] @? "drop failed" + git_annex "drop" [annexedfile, "--numcopies=2"] @? "drop failed" annexed_notpresent annexedfile - git_annex testenv "move" [annexedfile, "--from", "foo"] @? "move --from encrypted remote failed" + git_annex "move" [annexedfile, "--from", "foo"] @? "move --from encrypted remote failed" annexed_present annexedfile - not <$> git_annex testenv "drop" [annexedfile, "--numcopies=2"] @? "drop failed to fail" + not <$> git_annex "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. -} @@ -1327,30 +1321,27 @@ test_crypto testenv = do test_crypto _env = putStrLn "gpg testing not implemented on Windows" #endif -test_add_subdirs :: TestEnv -> Assertion -test_add_subdirs testenv = intmpclonerepo testenv $ do +test_add_subdirs :: Assertion +test_add_subdirs = intmpclonerepo $ do createDirectory "dir" writeFile ("dir" </> "foo") $ "dir/" ++ content annexedfile - git_annex testenv "add" ["dir"] @? "add of subdir failed" + git_annex "add" ["dir"] @? "add of subdir failed" {- Regression test for Windows bug where symlinks were not - calculated correctly for files in subdirs. -} - git_annex testenv "sync" [] @? "sync failed" + git_annex "sync" [] @? "sync failed" l <- annexeval $ decodeBS <$> Annex.CatFile.catObject (Git.Types.Ref "HEAD:dir/foo") "../.git/annex/" `isPrefixOf` l @? ("symlink from subdir to .git/annex is wrong: " ++ l) createDirectory "dir2" writeFile ("dir2" </> "foo") $ content annexedfile setCurrentDirectory "dir" - git_annex testenv "add" [".." </> "dir2"] @? "add of ../subdir failed" + git_annex "add" [".." </> "dir2"] @? "add of ../subdir failed" -- This is equivilant to running git-annex, but it's all run in-process --- (when the OS allows) so test coverage collection works. -git_annex :: TestEnv -> String -> [String] -> IO Bool -git_annex testenv command params = do - forM_ (M.toList testenv) $ \(var, val) -> - Utility.Env.setEnv var val True - +-- so test coverage collection works. +git_annex :: String -> [String] -> IO Bool +git_annex command params = do -- catch all errors, including normally fatal errors r <- try run::IO (Either SomeException ()) case r of @@ -1360,19 +1351,18 @@ git_annex testenv command params = do run = GitAnnex.run (command:"-q":params) {- Runs git-annex and returns its output. -} -git_annex_output :: TestEnv -> String -> [String] -> IO String -git_annex_output testenv command params = do - got <- Utility.Process.readProcessEnv "git-annex" (command:params) - (Just $ M.toList testenv) - -- XXX since the above is a separate process, code coverage stats are +git_annex_output :: String -> [String] -> IO String +git_annex_output command params = do + got <- Utility.Process.readProcess "git-annex" (command:params) + -- Since the above is a separate process, code coverage stats are -- not gathered for things run in it. -- Run same command again, to get code coverage. - _ <- git_annex testenv command params + _ <- git_annex command params return got -git_annex_expectoutput :: TestEnv -> String -> [String] -> [String] -> IO () -git_annex_expectoutput testenv command params expected = do - got <- lines <$> git_annex_output testenv command params +git_annex_expectoutput :: String -> [String] -> [String] -> IO () +git_annex_expectoutput command params expected = do + got <- lines <$> git_annex_output command params got == expected @? ("unexpected value running " ++ command ++ " " ++ show params ++ " -- got: " ++ show got ++ " expected: " ++ show expected) -- Runs an action in the current annex. Note that shutdown actions @@ -1384,17 +1374,17 @@ annexeval a = do Annex.setOutput Types.Messages.QuietOutput a -innewrepo :: TestEnv -> Assertion -> Assertion -innewrepo testenv a = withgitrepo testenv $ \r -> indir testenv r a +innewrepo :: Assertion -> Assertion +innewrepo a = withgitrepo $ \r -> indir r a -inmainrepo :: TestEnv -> Assertion -> Assertion -inmainrepo testenv = indir testenv mainrepodir +inmainrepo :: Assertion -> Assertion +inmainrepo = indir mainrepodir -intmpclonerepo :: TestEnv -> Assertion -> Assertion -intmpclonerepo testenv a = withtmpclonerepo testenv False $ \r -> indir testenv r a +intmpclonerepo :: Assertion -> Assertion +intmpclonerepo a = withtmpclonerepo False $ \r -> indir r a -intmpclonerepoInDirect :: TestEnv -> Assertion -> Assertion -intmpclonerepoInDirect testenv a = intmpclonerepo testenv $ +intmpclonerepoInDirect :: Assertion -> Assertion +intmpclonerepoInDirect a = intmpclonerepo $ ifM isdirect ( putStrLn "not supported in direct mode; skipping" , a @@ -1412,66 +1402,66 @@ checkRepo getval d = do isInDirect :: FilePath -> IO Bool isInDirect = checkRepo (not <$> Config.isDirect) -intmpbareclonerepo :: TestEnv -> Assertion -> Assertion -intmpbareclonerepo testenv a = withtmpclonerepo testenv True $ \r -> indir testenv r a +intmpbareclonerepo :: Assertion -> Assertion +intmpbareclonerepo a = withtmpclonerepo True $ \r -> indir r a -withtmpclonerepo :: TestEnv -> Bool -> (FilePath -> Assertion) -> Assertion -withtmpclonerepo testenv bare a = do +withtmpclonerepo :: Bool -> (FilePath -> Assertion) -> Assertion +withtmpclonerepo bare a = do dir <- tmprepodir - bracket (clonerepo testenv mainrepodir dir bare) cleanup a + bracket (clonerepo mainrepodir dir bare) cleanup a disconnectOrigin :: Assertion disconnectOrigin = boolSystem "git" [Params "remote rm origin"] @? "remote rm" -withgitrepo :: TestEnv -> (FilePath -> Assertion) -> Assertion -withgitrepo testenv = bracket (setuprepo testenv mainrepodir) return +withgitrepo :: (FilePath -> Assertion) -> Assertion +withgitrepo = bracket (setuprepo mainrepodir) return -indir :: TestEnv -> FilePath -> Assertion -> Assertion -indir testenv dir a = do +indir :: FilePath -> Assertion -> Assertion +indir dir a = do currdir <- getCurrentDirectory -- Assertion failures throw non-IO errors; catch -- any type of error and change back to currdir before -- rethrowing. - r <- bracket_ (changeToTmpDir testenv dir) (setCurrentDirectory currdir) + r <- bracket_ (changeToTmpDir dir) (setCurrentDirectory currdir) (try a::IO (Either SomeException ())) case r of Right () -> return () Left e -> throwM e -setuprepo :: TestEnv -> FilePath -> IO FilePath -setuprepo testenv dir = do +setuprepo :: FilePath -> IO FilePath +setuprepo dir = do cleanup dir ensuretmpdir boolSystem "git" [Params "init -q", File dir] @? "git init failed" - configrepo testenv dir + configrepo dir return dir -- clones are always done as local clones; we cannot test ssh clones -clonerepo :: TestEnv -> FilePath -> FilePath -> Bool -> IO FilePath -clonerepo testenv old new bare = do +clonerepo :: FilePath -> FilePath -> Bool -> IO FilePath +clonerepo old new bare = do cleanup new ensuretmpdir let b = if bare then " --bare" else "" boolSystem "git" [Params ("clone -q" ++ b), File old, File new] @? "git clone failed" - configrepo testenv new - indir testenv new $ - git_annex testenv "init" ["-q", new] @? "git annex init failed" + configrepo new + indir new $ + git_annex "init" ["-q", new] @? "git annex init failed" unless bare $ - indir testenv new $ - handleforcedirect testenv + indir new $ + handleforcedirect return new -configrepo :: TestEnv -> FilePath -> IO () -configrepo testenv dir = indir testenv dir $ do +configrepo :: FilePath -> IO () +configrepo dir = indir dir $ do -- ensure git is set up to let commits happen boolSystem "git" [Params "config user.name", Param "Test User"] @? "git config failed" boolSystem "git" [Params "config user.email test@example.com"] @? "git config failed" -- avoid signed commits by test suite boolSystem "git" [Params "config commit.gpgsign false"] @? "git config failed" -handleforcedirect :: TestEnv -> IO () -handleforcedirect testenv = when (M.lookup "FORCEDIRECT" testenv == Just "1") $ - git_annex testenv "direct" ["-q"] @? "git annex direct failed" +handleforcedirect :: IO () +handleforcedirect = whenM ((==) "1" <$> Utility.Env.getEnvDefault "FORCEDIRECT" "") $ + git_annex "direct" ["-q"] @? "git annex direct failed" ensuretmpdir :: IO () ensuretmpdir = do @@ -1581,31 +1571,27 @@ annexed_present = runchecks unannexed :: FilePath -> Assertion unannexed = runchecks [checkregularfile, checkcontent, checkwritable] -withTestEnv :: Bool -> (IO TestEnv -> TestTree) -> TestTree -withTestEnv forcedirect = withResource prepare release +withTestEnv :: Bool -> TestTree -> TestTree +withTestEnv forcedirect = withResource prepare release . const where prepare = do - testenv <- prepareTestEnv forcedirect - case tryIngredients [consoleTestReporter] mempty (initTests testenv) of + setTestEnv forcedirect + case tryIngredients [consoleTestReporter] mempty initTests of Nothing -> error "No tests found!?" Just act -> unlessM act $ error "init tests failed! cannot continue" - return testenv - release = releaseTestEnv - -releaseTestEnv :: TestEnv -> IO () -releaseTestEnv _env = cleanup' True tmpdir + return () + release _ = cleanup' True tmpdir -prepareTestEnv :: Bool -> IO TestEnv -prepareTestEnv forcedirect = do +setTestEnv :: Bool -> IO () +setTestEnv forcedirect = do whenM (doesDirectoryExist tmpdir) $ error $ "The temporary directory " ++ tmpdir ++ " already exists; cannot run test suite." currdir <- getCurrentDirectory p <- Utility.Env.getEnvDefault "PATH" "" - environ <- Utility.Env.getEnvironment - let newenv = + mapM_ (\(var, val) -> Utility.Env.setEnv var val True) -- Ensure that the just-built git annex is used. [ ("PATH", currdir ++ [searchPathSeparator] ++ p) , ("TOPDIR", currdir) @@ -1621,11 +1607,9 @@ prepareTestEnv forcedirect = do , ("FORCEDIRECT", if forcedirect then "1" else "") ] - return $ M.fromList newenv `M.union` M.fromList environ - -changeToTmpDir :: TestEnv -> FilePath -> IO () -changeToTmpDir testenv t = do - let topdir = fromMaybe "" $ M.lookup "TOPDIR" testenv +changeToTmpDir :: FilePath -> IO () +changeToTmpDir t = do + topdir <- Utility.Env.getEnvDefault "TOPDIR" (error "TOPDIR not set") setCurrentDirectory $ topdir ++ "/" ++ t tmpdir :: String |