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

test git-remote-annex

Browse source 
The added test case catches the reversion fixed in 700be6c38f
This commit is contained in:
Joey Hess 2024-11-11 13:40:59 -04:00
parent 700be6c38f
commit 79cf5b1a23
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
2 changed files with 95 additions and 72 deletions
Download patch file Download diff file Expand all files Collapse all files

131
Test.hs
View file

@ -1,6 +1,6 @@
{- git-annex test suite {- git-annex test suite
- -
- Copyright 2010-2023 Joey Hess <id@joeyh.name> - Copyright 2010-2024 Joey Hess <id@joeyh.name>
- -
- Licensed under the GNU AGPL version 3 or higher. - Licensed under the GNU AGPL version 3 or higher.
-} -}
@ -282,6 +282,7 @@ repoTests note numparts = map mk $ sep
[ testCase "add dup" test_add_dup [ testCase "add dup" test_add_dup
, testCase "add extras" test_add_extras , testCase "add extras" test_add_extras
, testCase "add moved link" test_add_moved , testCase "add moved link" test_add_moved
, testCase "git-remote-annex" test_git_remote_annex
, testCase "readonly remote" test_readonly_remote , testCase "readonly remote" test_readonly_remote
, testCase "ignore deleted files" test_ignore_deleted_files , testCase "ignore deleted files" test_ignore_deleted_files
, testCase "metadata" test_metadata , testCase "metadata" test_metadata
@ -421,6 +422,28 @@ test_add_extras = intmpclonerepo $ do
annexed_present wormannexedfile annexed_present wormannexedfile
checkbackend wormannexedfile backendWORM checkbackend wormannexedfile backendWORM
test_git_remote_annex :: Assertion
test_git_remote_annex = do
testspecialremote [] $
git_annex "copy" ["--to=foo"] "copy"
testspecialremote ["importtree=yes", "exporttree=yes"] $
git_annex "export" ["master", "--to=foo"] "export"
where
testspecialremote cfg populate = intmpclonerepo $ do
let cfg' = ["type=directory", "encryption=none", "directory=dir"] ++ cfg
createDirectory "dir"
git_annex "initremote" ("foo":("uuid=" ++ diruuid):cfg') "initremote"
git_annex "get" [] "get failed"
() <- populate
git "config" ["remote.foo.url", "annex::"] "git config"
git "push" ["foo", "master"] "git push"
git "push" ["foo", "git-annex"] "git push"
git "clone" ["annex::"++diruuid++"?"++intercalate "&" cfg', "clonedir"]
"git clone from special remote"
inpath "clonedir" $
git_annex "get" [annexedfile] "get from origin special remote"
diruuid="89ddefa4-a04c-11ef-87b5-e880882a4f98"
test_add_moved :: Assertion test_add_moved :: Assertion
test_add_moved = intmpclonerepo $ do test_add_moved = intmpclonerepo $ do
git_annex "get" [annexedfile] "get failed" git_annex "get" [annexedfile] "get failed"
@ -440,10 +463,10 @@ test_readonly_remote =
withtmpclonerepo $ \r1 -> withtmpclonerepo $ \r1 ->
withtmpclonerepo $ \r2 -> do withtmpclonerepo $ \r2 -> do
pair r1 r2 pair r1 r2
indir r1 $ do intopdir r1 $ do
git_annex "get" [annexedfile] "get failed in first repo" git_annex "get" [annexedfile] "get failed in first repo"
make_readonly r1 make_readonly r1
indir r2 $ do intopdir r2 $ do
git_annex "sync" ["r1", "--no-push", "--no-content"] "sync with readonly repo" git_annex "sync" ["r1", "--no-push", "--no-content"] "sync with readonly repo"
git_annex "get" [annexedfile, "--from", "r1"] "get from readonly repo" git_annex "get" [annexedfile, "--from", "r1"] "get from readonly repo"
git "remote" ["rm", "origin"] "remote rm" git "remote" ["rm", "origin"] "remote rm"
@ -1234,7 +1257,7 @@ test_union_merge_regression =
withtmpclonerepo $ \r1 -> withtmpclonerepo $ \r1 ->
withtmpclonerepo $ \r2 -> withtmpclonerepo $ \r2 ->
withtmpclonerepo $ \r3 -> do withtmpclonerepo $ \r3 -> do
forM_ [r1, r2, r3] $ \r -> indir r $ do forM_ [r1, r2, r3] $ \r -> intopdir r $ do
when (r /= r1) $ when (r /= r1) $
git "remote" ["add", "r1", "../" ++ r1] "remote add" git "remote" ["add", "r1", "../" ++ r1] "remote add"
when (r /= r2) $ when (r /= r2) $
@ -1243,11 +1266,11 @@ test_union_merge_regression =
git "remote" ["add", "r3", "../" ++ r3] "remote add" git "remote" ["add", "r3", "../" ++ r3] "remote add"
git_annex "get" [annexedfile] "get" git_annex "get" [annexedfile] "get"
git "remote" ["rm", "origin"] "remote rm" git "remote" ["rm", "origin"] "remote rm"
forM_ [r3, r2, r1] $ \r -> indir r $ forM_ [r3, r2, r1] $ \r -> intopdir r $
git_annex "sync" ["--no-content"] ("sync in " ++ r) git_annex "sync" ["--no-content"] ("sync in " ++ r)
forM_ [r3, r2] $ \r -> indir r $ forM_ [r3, r2] $ \r -> intopdir r $
git_annex "drop" ["--force", annexedfile] ("drop in " ++ r) git_annex "drop" ["--force", annexedfile] ("drop in " ++ r)
indir r1 $ do intopdir r1 $ do
git_annex "sync" ["--no-content"] "sync in r1" git_annex "sync" ["--no-content"] "sync in r1"
git_annex_expectoutput "find" ["--in", "r3"] [] git_annex_expectoutput "find" ["--in", "r3"] []
{- This was the bug. The sync {- This was the bug. The sync
@ -1261,19 +1284,19 @@ test_conflict_resolution_movein_regression :: Assertion
test_conflict_resolution_movein_regression = withtmpclonerepo $ \r1 -> test_conflict_resolution_movein_regression = withtmpclonerepo $ \r1 ->
withtmpclonerepo $ \r2 -> do withtmpclonerepo $ \r2 -> do
let rname r = if r == r1 then "r1" else "r2" let rname r = if r == r1 then "r1" else "r2"
forM_ [r1, r2] $ \r -> indir r $ do forM_ [r1, r2] $ \r -> intopdir r $ do
{- Get all files, see check below. -} {- Get all files, see check below. -}
git_annex "get" [] "get" git_annex "get" [] "get"
disconnectOrigin disconnectOrigin
pair r1 r2 pair r1 r2
forM_ [r1, r2] $ \r -> indir r $ do forM_ [r1, r2] $ \r -> intopdir r $ do
{- Set up a conflict. -} {- Set up a conflict. -}
let newcontent = content annexedfile ++ rname r let newcontent = content annexedfile ++ rname r
git_annex "unlock" [annexedfile] "unlock" git_annex "unlock" [annexedfile] "unlock"
writecontent annexedfile newcontent writecontent annexedfile newcontent
{- Sync twice in r1 so it gets the conflict resolution {- Sync twice in r1 so it gets the conflict resolution
- update from r2 -} - update from r2 -}
forM_ [r1, r2, r1] $ \r -> indir r $ forM_ [r1, r2, r1] $ \r -> intopdir r $
git_annex "sync" ["--force", "--no-content"] ("sync in " ++ rname r) git_annex "sync" ["--force", "--no-content"] ("sync in " ++ rname r)
{- After the sync, it should be possible to get all {- After the sync, it should be possible to get all
- files. This includes both sides of the conflict, - files. This includes both sides of the conflict,
@ -1281,7 +1304,7 @@ test_conflict_resolution_movein_regression = withtmpclonerepo $ \r1 ->
- -
- The bug caused one repo to be missing the content - The bug caused one repo to be missing the content
- of the file that had been put in it. -} - of the file that had been put in it. -}
forM_ [r1, r2] $ \r -> indir r $ do forM_ [r1, r2] $ \r -> intopdir r $ do
git_annex "get" [] ("get all files after merge conflict resolution in " ++ rname r) git_annex "get" [] ("get all files after merge conflict resolution in " ++ rname r)
{- Simple case of conflict resolution; 2 different versions of annexed {- Simple case of conflict resolution; 2 different versions of annexed
@ -1290,18 +1313,18 @@ test_conflict_resolution :: Assertion
test_conflict_resolution = test_conflict_resolution =
withtmpclonerepo $ \r1 -> withtmpclonerepo $ \r1 ->
withtmpclonerepo $ \r2 -> do withtmpclonerepo $ \r2 -> do
indir r1 $ do intopdir r1 $ do
disconnectOrigin disconnectOrigin
writecontent conflictor "conflictor1" writecontent conflictor "conflictor1"
add_annex conflictor "add conflicter" add_annex conflictor "add conflicter"
git_annex "sync" ["--no-content"] "sync in r1" git_annex "sync" ["--no-content"] "sync in r1"
indir r2 $ do intopdir r2 $ do
disconnectOrigin disconnectOrigin
writecontent conflictor "conflictor2" writecontent conflictor "conflictor2"
add_annex conflictor "add conflicter" add_annex conflictor "add conflicter"
git_annex "sync" ["--no-content"] "sync in r2" git_annex "sync" ["--no-content"] "sync in r2"
pair r1 r2 pair r1 r2
forM_ [r1,r2,r1] $ \r -> indir r $ forM_ [r1,r2,r1] $ \r -> intopdir r $
git_annex "sync" ["--no-content"] "sync" git_annex "sync" ["--no-content"] "sync"
checkmerge "r1" r1 checkmerge "r1" r1
checkmerge "r2" r2 checkmerge "r2" r2
@ -1314,7 +1337,7 @@ test_conflict_resolution =
length v == 2 length v == 2
@? (what ++ " not exactly 2 variant files in: " ++ show l) @? (what ++ " not exactly 2 variant files in: " ++ show l)
conflictor `notElem` l @? ("conflictor still present after conflict resolution") conflictor `notElem` l @? ("conflictor still present after conflict resolution")
indir d $ do intopdir d $ do
git_annex "get" v "get" git_annex "get" v "get"
git_annex_expectoutput "find" v v git_annex_expectoutput "find" v v
@ -1323,12 +1346,12 @@ test_conflict_resolution_adjusted_branch :: Assertion
test_conflict_resolution_adjusted_branch = test_conflict_resolution_adjusted_branch =
withtmpclonerepo $ \r1 -> withtmpclonerepo $ \r1 ->
withtmpclonerepo $ \r2 -> whenM (adjustedbranchsupported r2) $ do withtmpclonerepo $ \r2 -> whenM (adjustedbranchsupported r2) $ do
indir r1 $ do intopdir r1 $ do
disconnectOrigin disconnectOrigin
writecontent conflictor "conflictor1" writecontent conflictor "conflictor1"
add_annex conflictor "add conflicter" add_annex conflictor "add conflicter"
git_annex "sync" ["--no-content"] "sync in r1" git_annex "sync" ["--no-content"] "sync in r1"
indir r2 $ do intopdir r2 $ do
disconnectOrigin disconnectOrigin
writecontent conflictor "conflictor2" writecontent conflictor "conflictor2"
add_annex conflictor "add conflicter" add_annex conflictor "add conflicter"
@ -1338,7 +1361,7 @@ test_conflict_resolution_adjusted_branch =
-- filesystem. So, --force it. -- filesystem. So, --force it.
git_annex "adjust" ["--unlock", "--force"] "adjust" git_annex "adjust" ["--unlock", "--force"] "adjust"
pair r1 r2 pair r1 r2
forM_ [r1,r2,r1] $ \r -> indir r $ forM_ [r1,r2,r1] $ \r -> intopdir r $
git_annex "sync" ["--no-content"] "sync" git_annex "sync" ["--no-content"] "sync"
checkmerge "r1" r1 checkmerge "r1" r1
checkmerge "r2" r2 checkmerge "r2" r2
@ -1351,7 +1374,7 @@ test_conflict_resolution_adjusted_branch =
length v == 2 length v == 2
@? (what ++ " not exactly 2 variant files in: " ++ show l) @? (what ++ " not exactly 2 variant files in: " ++ show l)
conflictor `notElem` l @? ("conflictor still present after conflict resolution") conflictor `notElem` l @? ("conflictor still present after conflict resolution")
indir d $ do intopdir d $ do
git_annex "get" v "get" git_annex "get" v "get"
git_annex_expectoutput "find" v v git_annex_expectoutput "find" v v
@ -1364,12 +1387,12 @@ test_mixed_conflict_resolution = do
where where
check inr1 = withtmpclonerepo $ \r1 -> check inr1 = withtmpclonerepo $ \r1 ->
withtmpclonerepo $ \r2 -> do withtmpclonerepo $ \r2 -> do
indir r1 $ do intopdir r1 $ do
disconnectOrigin disconnectOrigin
writecontent conflictor "conflictor" writecontent conflictor "conflictor"
add_annex conflictor "add conflicter" add_annex conflictor "add conflicter"
git_annex "sync" ["--no-content"] "sync in r1" git_annex "sync" ["--no-content"] "sync in r1"
indir r2 $ do intopdir r2 $ do
disconnectOrigin disconnectOrigin
createDirectory conflictor createDirectory conflictor
writecontent subfile "subfile" writecontent subfile "subfile"
@ -1377,7 +1400,7 @@ test_mixed_conflict_resolution = do
git_annex "sync" ["--no-content"] "sync in r2" git_annex "sync" ["--no-content"] "sync in r2"
pair r1 r2 pair r1 r2
let l = if inr1 then [r1, r2] else [r2, r1] let l = if inr1 then [r1, r2] else [r2, r1]
forM_ l $ \r -> indir r $ forM_ l $ \r -> intopdir r $
git_annex "sync" ["--no-content"] "sync in mixed conflict" git_annex "sync" ["--no-content"] "sync in mixed conflict"
checkmerge "r1" r1 checkmerge "r1" r1
checkmerge "r2" r2 checkmerge "r2" r2
@ -1392,7 +1415,7 @@ test_mixed_conflict_resolution = do
@? (what ++ " conflictor variant file missing in: " ++ show l ) @? (what ++ " conflictor variant file missing in: " ++ show l )
length v == 1 length v == 1
@? (what ++ " too many variant files in: " ++ show v) @? (what ++ " too many variant files in: " ++ show v)
indir d $ do intopdir d $ do
git_annex "get" (conflictor:v) ("get in " ++ what) git_annex "get" (conflictor:v) ("get in " ++ what)
git_annex_expectoutput "find" [conflictor] [fromRawFilePath (Git.FilePath.toInternalGitPath (toRawFilePath subfile))] git_annex_expectoutput "find" [conflictor] [fromRawFilePath (Git.FilePath.toInternalGitPath (toRawFilePath subfile))]
git_annex_expectoutput "find" v v git_annex_expectoutput "find" v v
@ -1406,23 +1429,23 @@ test_remove_conflict_resolution = do
where where
check inr1 = withtmpclonerepo $ \r1 -> check inr1 = withtmpclonerepo $ \r1 ->
withtmpclonerepo $ \r2 -> do withtmpclonerepo $ \r2 -> do
indir r1 $ do intopdir r1 $ do
disconnectOrigin disconnectOrigin
writecontent conflictor "conflictor" writecontent conflictor "conflictor"
add_annex conflictor "add conflicter" add_annex conflictor "add conflicter"
git_annex "sync" ["--no-content"] "sync in r1" git_annex "sync" ["--no-content"] "sync in r1"
indir r2 $ intopdir r2 $
disconnectOrigin disconnectOrigin
pair r1 r2 pair r1 r2
indir r2 $ do intopdir r2 $ do
git_annex "sync" ["--no-content"] "sync in r2" git_annex "sync" ["--no-content"] "sync in r2"
git_annex "get" [conflictor] "get conflictor" git_annex "get" [conflictor] "get conflictor"
git_annex "unlock" [conflictor] "unlock conflictor" git_annex "unlock" [conflictor] "unlock conflictor"
writecontent conflictor "newconflictor" writecontent conflictor "newconflictor"
indir r1 $ intopdir r1 $
removeWhenExistsWith R.removeLink (toRawFilePath conflictor) removeWhenExistsWith R.removeLink (toRawFilePath conflictor)
let l = if inr1 then [r1, r2, r1] else [r2, r1, r2] let l = if inr1 then [r1, r2, r1] else [r2, r1, r2]
forM_ l $ \r -> indir r $ forM_ l $ \r -> intopdir r $
git_annex "sync" ["--no-content"] "sync" git_annex "sync" ["--no-content"] "sync"
checkmerge "r1" r1 checkmerge "r1" r1
checkmerge "r2" r2 checkmerge "r2" r2
@ -1446,12 +1469,12 @@ test_nonannexed_file_conflict_resolution = do
where where
check inr1 = withtmpclonerepo $ \r1 -> check inr1 = withtmpclonerepo $ \r1 ->
withtmpclonerepo $ \r2 -> do withtmpclonerepo $ \r2 -> do
indir r1 $ do intopdir r1 $ do
disconnectOrigin disconnectOrigin
writecontent conflictor "conflictor" writecontent conflictor "conflictor"
add_annex conflictor "add conflicter" add_annex conflictor "add conflicter"
git_annex "sync" ["--no-content"] "sync in r1" git_annex "sync" ["--no-content"] "sync in r1"
indir r2 $ do intopdir r2 $ do
disconnectOrigin disconnectOrigin
writecontent conflictor nonannexed_content writecontent conflictor nonannexed_content
git "config" git "config"
@ -1462,7 +1485,7 @@ test_nonannexed_file_conflict_resolution = do
git_annex "sync" ["--no-content"] "sync in r2" git_annex "sync" ["--no-content"] "sync in r2"
pair r1 r2 pair r1 r2
let l = if inr1 then [r1, r2] else [r2, r1] let l = if inr1 then [r1, r2] else [r2, r1]
forM_ l $ \r -> indir r $ forM_ l $ \r -> intopdir r $
git_annex "sync" ["--no-content"] "sync" git_annex "sync" ["--no-content"] "sync"
checkmerge "r1" r1 checkmerge "r1" r1
checkmerge "r2" r2 checkmerge "r2" r2
@ -1496,19 +1519,19 @@ test_nonannexed_symlink_conflict_resolution = do
check inr1 = withtmpclonerepo $ \r1 -> check inr1 = withtmpclonerepo $ \r1 ->
withtmpclonerepo $ \r2 -> withtmpclonerepo $ \r2 ->
whenM (checkRepo (Types.coreSymlinks <$> Annex.getGitConfig) r1) $ do whenM (checkRepo (Types.coreSymlinks <$> Annex.getGitConfig) r1) $ do
indir r1 $ do intopdir r1 $ do
disconnectOrigin disconnectOrigin
writecontent conflictor "conflictor" writecontent conflictor "conflictor"
add_annex conflictor "add conflicter" add_annex conflictor "add conflicter"
git_annex "sync" ["--no-content"] "sync in r1" git_annex "sync" ["--no-content"] "sync in r1"
indir r2 $ do intopdir r2 $ do
disconnectOrigin disconnectOrigin
R.createSymbolicLink (toRawFilePath symlinktarget) (toRawFilePath "conflictor") R.createSymbolicLink (toRawFilePath symlinktarget) (toRawFilePath "conflictor")
git "add" [conflictor] "git add conflictor" git "add" [conflictor] "git add conflictor"
git_annex "sync" ["--no-content"] "sync in r2" git_annex "sync" ["--no-content"] "sync in r2"
pair r1 r2 pair r1 r2
let l = if inr1 then [r1, r2] else [r2, r1] let l = if inr1 then [r1, r2] else [r2, r1]
forM_ l $ \r -> indir r $ forM_ l $ \r -> intopdir r $
git_annex "sync" ["--no-content"] "sync" git_annex "sync" ["--no-content"] "sync"
checkmerge "r1" r1 checkmerge "r1" r1
checkmerge "r2" r2 checkmerge "r2" r2
@ -1543,19 +1566,19 @@ test_uncommitted_conflict_resolution = do
where where
check remoteconflictor = withtmpclonerepo $ \r1 -> check remoteconflictor = withtmpclonerepo $ \r1 ->
withtmpclonerepo $ \r2 -> do withtmpclonerepo $ \r2 -> do
indir r1 $ do intopdir r1 $ do
disconnectOrigin disconnectOrigin
createDirectoryIfMissing True (fromRawFilePath (parentDir (toRawFilePath remoteconflictor))) createDirectoryIfMissing True (fromRawFilePath (parentDir (toRawFilePath remoteconflictor)))
writecontent remoteconflictor annexedcontent writecontent remoteconflictor annexedcontent
add_annex conflictor "add remoteconflicter" add_annex conflictor "add remoteconflicter"
git_annex "sync" ["--no-content"] "sync in r1" git_annex "sync" ["--no-content"] "sync in r1"
indir r2 $ do intopdir r2 $ do
disconnectOrigin disconnectOrigin
writecontent conflictor localcontent writecontent conflictor localcontent
pair r1 r2 pair r1 r2
-- this case is intentionally not handled -- this case is intentionally not handled
-- since the user can recover on their own easily -- since the user can recover on their own easily
indir r2 $ git_annex_shouldfail "sync" ["--no-content"] "sync should not succeed" intopdir r2 $ git_annex_shouldfail "sync" ["--no-content"] "sync should not succeed"
conflictor = "conflictor" conflictor = "conflictor"
localcontent = "local" localcontent = "local"
annexedcontent = "annexed" annexedcontent = "annexed"
@ -1568,18 +1591,18 @@ test_conflict_resolution_symlink_bit = unlessM (hasUnlockedFiles <$> getTestMode
withtmpclonerepo $ \r1 -> withtmpclonerepo $ \r1 ->
withtmpclonerepo $ \r2 -> withtmpclonerepo $ \r2 ->
withtmpclonerepo $ \r3 -> do withtmpclonerepo $ \r3 -> do
indir r1 $ do intopdir r1 $ do
writecontent conflictor "conflictor" writecontent conflictor "conflictor"
git_annex "add" [conflictor] "add conflicter" git_annex "add" [conflictor] "add conflicter"
git_annex "sync" ["--no-content"] "sync in r1" git_annex "sync" ["--no-content"] "sync in r1"
check_is_link conflictor "r1" check_is_link conflictor "r1"
indir r2 $ do intopdir r2 $ do
createDirectory conflictor createDirectory conflictor
writecontent (conflictor </> "subfile") "subfile" writecontent (conflictor </> "subfile") "subfile"
git_annex "add" [conflictor] "add conflicter" git_annex "add" [conflictor] "add conflicter"
git_annex "sync" ["--no-content"] "sync in r2" git_annex "sync" ["--no-content"] "sync in r2"
check_is_link (conflictor </> "subfile") "r2" check_is_link (conflictor </> "subfile") "r2"
indir r3 $ do intopdir r3 $ do
writecontent conflictor "conflictor" writecontent conflictor "conflictor"
git_annex "add" [conflictor] "add conflicter" git_annex "add" [conflictor] "add conflicter"
git_annex "sync" ["--no-content"] "sync in r1" git_annex "sync" ["--no-content"] "sync in r1"
@ -1599,26 +1622,26 @@ test_mixed_lock_conflict_resolution :: Assertion
test_mixed_lock_conflict_resolution = test_mixed_lock_conflict_resolution =
withtmpclonerepo $ \r1 -> withtmpclonerepo $ \r1 ->
withtmpclonerepo $ \r2 -> do withtmpclonerepo $ \r2 -> do
indir r1 $ do intopdir r1 $ do
disconnectOrigin disconnectOrigin
writecontent conflictor "conflictor" writecontent conflictor "conflictor"
git_annex "add" [conflictor] "add conflicter" git_annex "add" [conflictor] "add conflicter"
git_annex "sync" ["--no-content"] "sync in r1" git_annex "sync" ["--no-content"] "sync in r1"
indir r2 $ do intopdir r2 $ do
disconnectOrigin disconnectOrigin
writecontent conflictor "conflictor" writecontent conflictor "conflictor"
git_annex "add" [conflictor] "add conflicter" git_annex "add" [conflictor] "add conflicter"
git_annex "unlock" [conflictor] "unlock conflicter" git_annex "unlock" [conflictor] "unlock conflicter"
git_annex "sync" ["--no-content"] "sync in r2" git_annex "sync" ["--no-content"] "sync in r2"
pair r1 r2 pair r1 r2
forM_ [r1,r2,r1] $ \r -> indir r $ forM_ [r1,r2,r1] $ \r -> intopdir r $
git_annex "sync" ["--no-content"] "sync" git_annex "sync" ["--no-content"] "sync"
checkmerge "r1" r1 checkmerge "r1" r1
checkmerge "r2" r2 checkmerge "r2" r2
where where
conflictor = "conflictor" conflictor = "conflictor"
variantprefix = conflictor ++ ".variant" variantprefix = conflictor ++ ".variant"
checkmerge what d = indir d $ do checkmerge what d = intopdir d $ do
l <- getDirectoryContents "." l <- getDirectoryContents "."
let v = filter (variantprefix `isPrefixOf`) l let v = filter (variantprefix `isPrefixOf`) l
length v == 0 length v == 0
@ -1643,14 +1666,14 @@ test_adjusted_branch_merge_regression = do
checkmerge "r2" r2 checkmerge "r2" r2
where where
conflictor = "conflictor" conflictor = "conflictor"
setup r = indir r $ whensupported $ do setup r = intopdir r $ whensupported $ do
disconnectOrigin disconnectOrigin
git_annex "upgrade" [] "upgrade" git_annex "upgrade" [] "upgrade"
git_annex "adjust" ["--unlock", "--force"] "adjust" git_annex "adjust" ["--unlock", "--force"] "adjust"
writecontent conflictor "conflictor" writecontent conflictor "conflictor"
git_annex "add" [conflictor] "add conflicter" git_annex "add" [conflictor] "add conflicter"
git_annex "sync" ["--no-content"] "sync" git_annex "sync" ["--no-content"] "sync"
checkmerge what d = indir d $ whensupported $ do checkmerge what d = intopdir d $ whensupported $ do
git_annex "sync" ["--no-content"] ("sync should not work in " ++ what) git_annex "sync" ["--no-content"] ("sync should not work in " ++ what)
l <- getDirectoryContents "." l <- getDirectoryContents "."
conflictor `elem` l conflictor `elem` l
@ -1664,7 +1687,7 @@ test_adjusted_branch_merge_regression = do
test_adjusted_branch_subtree_regression :: Assertion test_adjusted_branch_subtree_regression :: Assertion
test_adjusted_branch_subtree_regression = test_adjusted_branch_subtree_regression =
withtmpclonerepo $ \r -> whenM (adjustedbranchsupported r) $ do withtmpclonerepo $ \r -> whenM (adjustedbranchsupported r) $ do
indir r $ do intopdir r $ do
disconnectOrigin disconnectOrigin
origbranch <- annexeval origBranch origbranch <- annexeval origBranch
git_annex "upgrade" [] "upgrade" git_annex "upgrade" [] "upgrade"
@ -2086,31 +2109,31 @@ test_transition_propagation_reversion =
withtmpclonerepo $ \r1 -> withtmpclonerepo $ \r1 ->
withtmpclonerepo $ \r2 -> do withtmpclonerepo $ \r2 -> do
pair r1 r2 pair r1 r2
indir r1 $ do intopdir r1 $ do
disconnectOrigin disconnectOrigin
writecontent wormannexedfile $ content wormannexedfile writecontent wormannexedfile $ content wormannexedfile
git_annex "add" [wormannexedfile, "--backend=WORM"] "add" git_annex "add" [wormannexedfile, "--backend=WORM"] "add"
git_annex "sync" ["--no-content"] "sync" git_annex "sync" ["--no-content"] "sync"
indir r2 $ do intopdir r2 $ do
disconnectOrigin disconnectOrigin
git_annex "sync" ["--no-content"] "sync" git_annex "sync" ["--no-content"] "sync"
indir r1 $ do intopdir r1 $ do
git_annex "sync" ["--no-content"] "sync" git_annex "sync" ["--no-content"] "sync"
indir r2 $ do intopdir r2 $ do
git_annex "get" [wormannexedfile] "get" git_annex "get" [wormannexedfile] "get"
git_annex "drop" [wormannexedfile] "drop" git_annex "drop" [wormannexedfile] "drop"
git_annex "get" [wormannexedfile] "get" git_annex "get" [wormannexedfile] "get"
git_annex "drop" [wormannexedfile] "drop" git_annex "drop" [wormannexedfile] "drop"
indir r1 $ do intopdir r1 $ do
git_annex "drop" ["--force", wormannexedfile] "drop" git_annex "drop" ["--force", wormannexedfile] "drop"
git_annex "sync" ["--no-content"] "sync" git_annex "sync" ["--no-content"] "sync"
git_annex "forget" ["--force"] "forget" git_annex "forget" ["--force"] "forget"
git_annex "sync" ["--no-content"] "sync" git_annex "sync" ["--no-content"] "sync"
emptylog emptylog
indir r2 $ do intopdir r2 $ do
git_annex "sync" ["--no-content"] "sync" git_annex "sync" ["--no-content"] "sync"
emptylog emptylog
indir r1 $ do intopdir r1 $ do
git_annex "sync" ["--no-content"] "sync" git_annex "sync" ["--no-content"] "sync"
emptylog emptylog
where where

36
Test/Framework.hs
View file

@ -140,12 +140,12 @@ annexeval a = do
a `finally` Annex.Action.stopCoProcesses a `finally` Annex.Action.stopCoProcesses
innewrepo :: IO () -> IO () innewrepo :: IO () -> IO ()
innewrepo a = withgitrepo $ \r -> indir r a innewrepo a = withgitrepo $ \r -> intopdir r a
inmainrepo :: IO a -> IO a inmainrepo :: IO a -> IO a
inmainrepo a = do inmainrepo a = do
d <- mainrepodir d <- mainrepodir
indir d a intopdir d a
with_ssh_origin :: (Assertion -> Assertion) -> (Assertion -> Assertion) with_ssh_origin :: (Assertion -> Assertion) -> (Assertion -> Assertion)
with_ssh_origin cloner a = cloner $ do with_ssh_origin cloner a = cloner $ do
@ -160,7 +160,7 @@ with_ssh_origin cloner a = cloner $ do
config = "remote.origin.url" config = "remote.origin.url"
intmpclonerepo :: Assertion -> Assertion intmpclonerepo :: Assertion -> Assertion
intmpclonerepo a = withtmpclonerepo $ \r -> indir r a intmpclonerepo a = withtmpclonerepo $ \r -> intopdir r a
checkRepo :: Types.Annex a -> FilePath -> IO a checkRepo :: Types.Annex a -> FilePath -> IO a
checkRepo getval d = do checkRepo getval d = do
@ -170,11 +170,11 @@ checkRepo getval d = do
intmpbareclonerepo :: Assertion -> Assertion intmpbareclonerepo :: Assertion -> Assertion
intmpbareclonerepo a = withtmpclonerepo' (newCloneRepoConfig { bareClone = True } ) $ intmpbareclonerepo a = withtmpclonerepo' (newCloneRepoConfig { bareClone = True } ) $
\r -> indir r a \r -> intopdir r a
intmpsharedclonerepo :: Assertion -> Assertion intmpsharedclonerepo :: Assertion -> Assertion
intmpsharedclonerepo a = withtmpclonerepo' (newCloneRepoConfig { sharedClone = True } ) $ intmpsharedclonerepo a = withtmpclonerepo' (newCloneRepoConfig { sharedClone = True } ) $
\r -> indir r a \r -> intopdir r a
withtmpclonerepo :: (FilePath -> Assertion) -> Assertion withtmpclonerepo :: (FilePath -> Assertion) -> Assertion
withtmpclonerepo = withtmpclonerepo' newCloneRepoConfig withtmpclonerepo = withtmpclonerepo' newCloneRepoConfig
@ -200,14 +200,19 @@ withgitrepo a = do
maindir <- mainrepodir maindir <- mainrepodir
bracket (setuprepo maindir) return a bracket (setuprepo maindir) return a
indir :: FilePath -> IO a -> IO a intopdir :: FilePath -> IO a -> IO a
indir dir a = do intopdir dir a = do
topdir <- Utility.Env.getEnvDefault "TOPDIR" (error "TOPDIR not set")
inpath (topdir ++ "/" ++ dir) a
inpath :: FilePath -> IO a -> IO a
inpath path a = do
currdir <- getCurrentDirectory currdir <- getCurrentDirectory
-- Assertion failures throw non-IO errors; catch -- Assertion failures throw non-IO errors; catch
-- any type of error and change back to currdir before -- any type of error and change back to currdir before
-- rethrowing. -- rethrowing.
r <- bracket_ r <- bracket_
(changeToTopDir dir) (setCurrentDirectory path)
(setCurrentDirectory currdir) (setCurrentDirectory currdir)
(tryNonAsync a) (tryNonAsync a)
case r of case r of
@ -215,7 +220,7 @@ indir dir a = do
Left e -> throwM e Left e -> throwM e
adjustedbranchsupported :: FilePath -> IO Bool adjustedbranchsupported :: FilePath -> IO Bool
adjustedbranchsupported repo = indir repo $ Annex.AdjustedBranch.isGitVersionSupported adjustedbranchsupported repo = intopdir repo $ Annex.AdjustedBranch.isGitVersionSupported
setuprepo :: FilePath -> IO FilePath setuprepo :: FilePath -> IO FilePath
setuprepo dir = do setuprepo dir = do
@ -248,7 +253,7 @@ clonerepo old new cfg = do
] ]
git "clone" cloneparams "git clone" git "clone" cloneparams "git clone"
configrepo new configrepo new
indir new $ do intopdir new $ do
ver <- annexVersion <$> getTestMode ver <- annexVersion <$> getTestMode
git_annex "init" git_annex "init"
[ "-q" [ "-q"
@ -257,12 +262,12 @@ clonerepo old new cfg = do
] ]
"git annex init" "git annex init"
unless (bareClone cfg) $ unless (bareClone cfg) $
indir new $ intopdir new $
setupTestMode setupTestMode
return new return new
configrepo :: FilePath -> IO () configrepo :: FilePath -> IO ()
configrepo dir = indir dir $ do configrepo dir = intopdir dir $ do
-- ensure git is set up to let commits happen -- ensure git is set up to let commits happen
git "config" ["user.name", "Test User"] git "config" ["user.name", "Test User"]
"git config" "git config"
@ -556,11 +561,6 @@ setupTestMode = do
git "commit" ["--allow-empty", "-m", "empty"] "git commit failed" git "commit" ["--allow-empty", "-m", "empty"] "git commit failed"
git_annex "adjust" ["--unlock"] "git annex adjust failed" git_annex "adjust" ["--unlock"] "git annex adjust failed"
changeToTopDir :: FilePath -> IO ()
changeToTopDir t = do
topdir <- Utility.Env.getEnvDefault "TOPDIR" (error "TOPDIR not set")
setCurrentDirectory $ topdir ++ "/" ++ t
tmpdir :: String tmpdir :: String
tmpdir = ".t" tmpdir = ".t"
@ -687,7 +687,7 @@ origBranch = maybe "foo"
{- Set up repos as remotes of each other. -} {- Set up repos as remotes of each other. -}
pair :: FilePath -> FilePath -> Assertion pair :: FilePath -> FilePath -> Assertion
pair r1 r2 = forM_ [r1, r2] $ \r -> indir r $ do pair r1 r2 = forM_ [r1, r2] $ \r -> intopdir r $ do
when (r /= r1) $ when (r /= r1) $
git "remote" ["add", "r1", "../" ++ r1] "remote add" git "remote" ["add", "r1", "../" ++ r1] "remote add"
when (r /= r2) $ when (r /= r2) $