add testremote of a git remote to test suite

The test suite contains its own tests that test a lot of basic stuff
about git remotes, mostly in passing to set up other situations.
But testremote does try some unusual edge cases, which may as
well be tried for git remotes as well as directory, especially since
it's so little code to add it.

This commit was sponsored by Kevin Mueller on Patreon.
This commit is contained in:
Joey Hess 2021-01-11 13:05:27 -04:00
parent 96a7a1fb71
commit faef32767e
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38

37
Test.hs
View file

@ -224,17 +224,30 @@ properties = localOption (QuickCheckTests 1000) $ testGroup "QuickCheck" $
testRemotes :: TestTree testRemotes :: TestTree
testRemotes = testGroup "Remote Tests" testRemotes = testGroup "Remote Tests"
[ testRemote "directory" [ testGitRemote
[ "directory=remotedir" , testDirectoryRemote
, "encryption=none"
]
(createDirectory "remotedir")
] ]
testRemote :: String -> [String] -> IO () -> TestTree testGitRemote :: TestTree
testRemote remotetype config preinitremote = testGitRemote = testRemote "git" $ \remotename -> do
git "clone" [".", "remotedir"] "git clone"
git "remote" ["add", remotename, "remotedir"] "git remote add"
testDirectoryRemote :: TestTree
testDirectoryRemote = testRemote "directory" $ \remotename -> do
createDirectory "remotedir"
git_annex "initremote"
[ remotename
, "type=directory"
, "--quiet"
, "directory=remotedir"
, "encryption=none"
] "init"
testRemote :: String -> (String -> IO ()) -> TestTree
testRemote remotetype setupremote =
withResource newEmptyTMVarIO (const noop) $ \getv -> withResource newEmptyTMVarIO (const noop) $ \getv ->
testGroup ("remote type " ++ remotetype) $ concat testGroup ("testremote type " ++ remotetype) $ concat
[ [testCase "init" (prep getv)] [ [testCase "init" (prep getv)]
, go getv , go getv
] ]
@ -248,13 +261,7 @@ testRemote remotetype config preinitremote =
setmainrepodir d setmainrepodir d
innewrepo $ do innewrepo $ do
git_annex "init" [reponame, "--quiet"] "init" git_annex "init" [reponame, "--quiet"] "init"
preinitremote setupremote remotename
git_annex "initremote"
([ remotename
, "type=" ++ remotetype
, "--quiet"
] ++ config)
"init"
r <- annexeval $ either error return r <- annexeval $ either error return
=<< Remote.byName' remotename =<< Remote.byName' remotename
cache <- Command.TestRemote.newRemoteVariantCache cache <- Command.TestRemote.newRemoteVariantCache