add checks that location log files are committed

currently failing for move --to
This commit is contained in:
Joey Hess 2011-01-11 16:00:40 -04:00
parent 3a844b1f3c
commit a8ce30401d
3 changed files with 19 additions and 0 deletions

View file

@ -38,6 +38,7 @@ module GitRepo (
inRepo,
notInRepo,
stagedFiles,
changedUnstagedFiles,
checkAttr,
decodeGitFile,
encodeGitFile,
@ -249,6 +250,11 @@ stagedFiles repo l = pipeNullSplit repo $
["diff", "--cached", "--name-only", "--diff-filter=ACMRT", "-z",
"--"] ++ l
{- Returns a list of files that have unstaged changes. -}
changedUnstagedFiles :: Repo -> [FilePath] -> IO [FilePath]
changedUnstagedFiles repo l = pipeNullSplit repo $
["diff", "--name-only", "-z", "--"] ++ l
{- Returns a list of the files in the specified locations that are staged
- for commit, and whose type has changed. -}
typeChangedStagedFiles :: Repo -> [FilePath] -> IO [FilePath]

View file

@ -23,6 +23,7 @@
module LocationLog (
LogStatus(..),
logChange,
logFile,
keyLocations
) where

12
test.hs
View file

@ -375,6 +375,18 @@ checklocationlog f expected = do
uuids <- LocationLog.keyLocations g' k
assertEqual ("location log for " ++ f ++ " " ++ (show k) ++ " " ++ thisuuid)
expected (elem thisuuid uuids)
-- Location log files should always be checked
-- into git, and any modifications staged for
-- commit. This is a regression test, as some
-- commands forgot to.
let lf = LocationLog.logFile g' k
fs <- Git.inRepo g' [lf]
when (null fs) $
assertFailure $ f ++ " logfile not added to git repo"
ufs <- Git.changedUnstagedFiles g' [lf]
when (not $ null ufs) $
assertFailure $ f ++ " logfile changes not staged"
_ -> assertFailure $ f ++ " failed to look up key"
inlocationlog :: FilePath -> Assertion