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

added remote variants

Browse source 
Todo item is done at last.

Might later want to think about testing some other types of remotes that
can be tested locally. The git remote itself is probably already well
enough tested by the test suite that testremote is not needed. Could
test things like bup, or rsync to a local directory. Or even external,
although that would require embedding an external special remote program
into the test suite..
This commit is contained in:
Joey Hess 2020-04-30 13:49:22 -04:00
parent fc1ae62ef1
commit 9fa940569c
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
3 changed files with 64 additions and 46 deletions
Download patch file Download diff file Expand all files Collapse all files

38
Test.hs
View file

@ -148,7 +148,7 @@ ingredients =
tests :: Bool -> Bool -> TestOptions -> TestTree
tests crippledfilesystem adjustedbranchok opts =
testGroup "Tests" $ properties
: withTestMode remotetestmode Nothing testRemote
: withTestMode remotetestmode Nothing testRemotes
: map (\(d, te) -> withTestMode te (Just initTests) (unitTests d)) testmodes
where
testmodes = catMaybes
@ -207,16 +207,25 @@ properties = localOption (QuickCheckTests 1000) $ testGroup "QuickCheck" $
, Utility.Hash.props_macs_stable
]
testRemote :: TestTree
testRemote = withResource newEmptyTMVarIO (const noop) $ \getv ->
testGroup "Remote Tests" $ concat
[ [testCase "init" (prep getv)]
, go getv
testRemotes :: TestTree
testRemotes = testGroup "Remote Tests"
[ testRemote "directory"
[ "directory=remotedir"
, "encryption=none"
]
(createDirectory "remotedir")
]
testRemote :: String -> [String] -> IO () -> TestTree
testRemote remotetype config preinitremote =
withResource newEmptyTMVarIO (const noop) $ \getv ->
testGroup ("remote type " ++ remotetype) $ concat
[ [testCase "init" (prep getv)]
, go getv
]
where
reponame = "test repo"
remotename = "dir"
remotetype =" directory"
remotename = "testremote"
basesz = 1024 * 1024
keysizes = Command.TestRemote.keySizes basesz False
prep getv = do
@ -225,17 +234,15 @@ testRemote = withResource newEmptyTMVarIO (const noop) $ \getv ->
innewrepo $ do
git_annex "init" [reponame, "--quiet"]
@? "init failed"
createDirectory "remotedir"
preinitremote
git_annex "initremote"
[ remotename
([ remotename
, "type=" ++ remotetype
, "directory=remotedir"
, "encryption=none"
, "--quiet"
]
] ++ config)
@? "init failed"
r <- annexeval $ either error return
=<< Remote.byName' remotename
=<< Remote.byName' remotename
unavailr <- annexeval $ Types.Remote.mkUnavailable r
exportr <- annexeval $ Command.TestRemote.exportTreeVariant r
ks <- annexeval $ mapM Command.TestRemote.randKey keysizes
@ -245,7 +252,8 @@ testRemote = withResource newEmptyTMVarIO (const noop) $ \getv ->
go getv = Command.TestRemote.mkTestTrees runannex mkrs mkunavailr mkexportr mkks
where
runannex = inmainrepo . annexeval
mkrs = [descas (remotetype ++ " remote") (fst <$> v)]
mkrs = Command.TestRemote.remoteVariants mkr basesz False
mkr = descas (remotetype ++ " remote") (fst <$> v)
mkunavailr = fst . snd <$> v
mkexportr = fst . snd . snd <$> v
mkks = map (\(sz, n) -> desckeysize sz (getk n))