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

testremote: Add testing of behavior when remote is not available

Browse source 
Added a mkUnavailable method, which a Remote can use to generate a version
of itself that is not available. Implemented for several, but not yet all
remotes.

This allows testing that checkPresent properly throws an exceptions when
it cannot check if a key is present or not. It also allows testing that the
other methods don't throw exceptions in these circumstances.

This immediately found several bugs, which this commit also fixes!

* git remotes using ssh accidentially had checkPresent return
  an exception, rather than throwing it
* The chunking code accidentially returned False rather than
  propigating an exception when there were no chunks and
  checkPresent threw an exception for the non-chunked key.

This commit was sponsored by Carlo Matteo Capocasa.
This commit is contained in:
Joey Hess 2014-08-10 14:52:58 -04:00
parent 2fd9518f72
commit 6adbd50cd9
18 changed files with 92 additions and 30 deletions
Download patch file Download diff file Expand all files Collapse all files

2
Command/Map.hs
View file

@ -200,7 +200,7 @@ tryScan r
where
p = proc cmd $ toCommand params
configlist = Ssh.onRemote r (pipedconfig, Nothing) "configlist" [] []
configlist = Ssh.onRemote r (pipedconfig, return Nothing) "configlist" [] []
manualconfiglist = do
gc <- Annex.getRemoteGitConfig r
sshparams <- Ssh.toRepo r gc [Param sshcmd]

35
Command/TestRemote.hs
View file

@ -62,13 +62,16 @@ start basesz ws = do
ks <- mapM randKey (keySizes basesz fast)
rs <- catMaybes <$> mapM (adjustChunkSize r) (chunkSizes basesz fast)
rs' <- concat <$> mapM encryptionVariants rs
next $ perform rs' ks
unavailrs <- catMaybes <$> mapM Remote.mkUnavailable [r]
next $ perform rs' unavailrs ks
perform :: [Remote] -> [Key] -> CommandPerform
perform rs ks = do
perform :: [Remote] -> [Remote] -> [Key] -> CommandPerform
perform rs unavailrs ks = do
st <- Annex.getState id
let tests = testGroup "Remote Tests" $
[ testGroup (desc r k) (test st r k) | k <- ks, r <- rs ]
let tests = testGroup "Remote Tests" $ concat
[ [ testGroup "unavailable remote" (testUnavailable st r (Prelude.head ks)) | r <- unavailrs ]
, [ testGroup (desc r k) (test st r k) | k <- ks, r <- rs ]
]
ok <- case tryIngredients [consoleTestReporter] mempty tests of
Nothing -> error "No tests found!?"
Just act -> liftIO act
@ -155,6 +158,28 @@ test st r k =
store = Remote.storeKey r k Nothing nullMeterUpdate
remove = Remote.removeKey r k
testUnavailable :: Annex.AnnexState -> Remote -> Key -> [TestTree]
testUnavailable st r k =
[ check (== Right False) "removeKey" $
Remote.removeKey r k
, check (== Right False) "storeKey" $
Remote.storeKey r k Nothing nullMeterUpdate
, check (`notElem` [Right True, Right False]) "checkPresent" $
Remote.checkPresent r k
, check (== Right False) "retrieveKeyFile" $
getViaTmp k $ \dest ->
Remote.retrieveKeyFile r k Nothing dest nullMeterUpdate
, check (== Right False) "retrieveKeyFileCheap" $
getViaTmp k $ \dest ->
Remote.retrieveKeyFileCheap r k dest
]
where
check checkval desc a = testCase desc $ do
v <- Annex.eval st $ do
Annex.setOutput QuietOutput
either (Left . show) Right <$> tryNonAsync a
checkval v @? ("(got: " ++ show v ++ ")")
cleanup :: [Remote] -> [Key] -> Bool -> CommandCleanup
cleanup rs ks ok = do
forM_ rs $ \r -> forM_ ks (Remote.removeKey r)