testremote: Add testing of behavior when remote is not available
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:
parent
2fd9518f72
commit
6adbd50cd9
18 changed files with 92 additions and 30 deletions
|
@ -69,7 +69,7 @@ git_annex_shell r command params fields
|
|||
- a specified error value. -}
|
||||
onRemote
|
||||
:: Git.Repo
|
||||
-> (FilePath -> [CommandParam] -> IO a, a)
|
||||
-> (FilePath -> [CommandParam] -> IO a, Annex a)
|
||||
-> String
|
||||
-> [CommandParam]
|
||||
-> [(Field, String)]
|
||||
|
@ -78,7 +78,7 @@ onRemote r (with, errorval) command params fields = do
|
|||
s <- git_annex_shell r command params fields
|
||||
case s of
|
||||
Just (c, ps) -> liftIO $ with c ps
|
||||
Nothing -> return errorval
|
||||
Nothing -> errorval
|
||||
|
||||
{- Checks if a remote contains a key. -}
|
||||
inAnnex :: Git.Repo -> Key -> Annex Bool
|
||||
|
@ -86,14 +86,14 @@ inAnnex r k = do
|
|||
showChecking r
|
||||
onRemote r (check, cantCheck r) "inannex" [Param $ key2file k] []
|
||||
where
|
||||
check c p = dispatch <$> safeSystem c p
|
||||
dispatch ExitSuccess = True
|
||||
dispatch (ExitFailure 1) = False
|
||||
check c p = dispatch =<< safeSystem c p
|
||||
dispatch ExitSuccess = return True
|
||||
dispatch (ExitFailure 1) = return False
|
||||
dispatch _ = cantCheck r
|
||||
|
||||
{- Removes a key from a remote. -}
|
||||
dropKey :: Git.Repo -> Key -> Annex Bool
|
||||
dropKey r key = onRemote r (boolSystem, False) "dropkey"
|
||||
dropKey r key = onRemote r (boolSystem, return False) "dropkey"
|
||||
[ Params "--quiet --force"
|
||||
, Param $ key2file key
|
||||
]
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue