on second thought, unlock should fail if content is not present
This commit is contained in:
parent
c1839fdccb
commit
59c9eda962
2 changed files with 8 additions and 7 deletions
|
@ -7,6 +7,7 @@
|
||||||
|
|
||||||
module Command.Unlock where
|
module Command.Unlock where
|
||||||
|
|
||||||
|
import Control.Monad (when)
|
||||||
import Control.Monad.State (liftIO)
|
import Control.Monad.State (liftIO)
|
||||||
import System.Directory hiding (copyFile)
|
import System.Directory hiding (copyFile)
|
||||||
|
|
||||||
|
@ -32,15 +33,15 @@ seek = [withFilesInGit start]
|
||||||
- content. -}
|
- content. -}
|
||||||
start :: CommandStartString
|
start :: CommandStartString
|
||||||
start file = isAnnexed file $ \(key, _) -> do
|
start file = isAnnexed file $ \(key, _) -> do
|
||||||
inbackend <- Backend.hasKey key
|
showStart "unlock" file
|
||||||
if not inbackend
|
return $ Just $ perform file key
|
||||||
then return Nothing
|
|
||||||
else do
|
|
||||||
showStart "unlock" file
|
|
||||||
return $ Just $ perform file key
|
|
||||||
|
|
||||||
perform :: FilePath -> Key -> CommandPerform
|
perform :: FilePath -> Key -> CommandPerform
|
||||||
perform dest key = do
|
perform dest key = do
|
||||||
|
inbackend <- Backend.hasKey key
|
||||||
|
when (not inbackend) $
|
||||||
|
error "content not present"
|
||||||
|
|
||||||
g <- Annex.gitRepo
|
g <- Annex.gitRepo
|
||||||
let src = annexLocation g key
|
let src = annexLocation g key
|
||||||
liftIO $ removeFile dest
|
liftIO $ removeFile dest
|
||||||
|
|
2
test.hs
2
test.hs
|
@ -218,7 +218,7 @@ test_lock = "git-annex unlock/lock" ~: intmpclonerepo $ do
|
||||||
-- regression test: unlock of not present file should skip it
|
-- regression test: unlock of not present file should skip it
|
||||||
annexed_notpresent annexedfile
|
annexed_notpresent annexedfile
|
||||||
r <- git_annex "unlock" ["-q", annexedfile]
|
r <- git_annex "unlock" ["-q", annexedfile]
|
||||||
r @? "unlock failed with not present file"
|
not r @? "unlock failed to fail with not present file"
|
||||||
annexed_notpresent annexedfile
|
annexed_notpresent annexedfile
|
||||||
|
|
||||||
git_annex "get" ["-q", annexedfile] @? "get of file failed"
|
git_annex "get" ["-q", annexedfile] @? "get of file failed"
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue