test locationlog contents too

This commit is contained in:
Joey Hess 2011-01-11 15:43:29 -04:00
parent c2b13a88bf
commit 3a844b1f3c

30
test.hs
View file

@ -18,11 +18,15 @@ import System.Posix.Env
import qualified Control.Exception.Extensible as E import qualified Control.Exception.Extensible as E
import Control.Exception (throw) import Control.Exception (throw)
import qualified Annex
import qualified BackendList
import qualified Backend
import qualified GitRepo as Git import qualified GitRepo as Git
import qualified Locations import qualified Locations
import qualified Utility import qualified Utility
import qualified TypeInternals import qualified TypeInternals
import qualified GitAnnex import qualified GitAnnex
import qualified LocationLog
main :: IO () main :: IO ()
main = do main = do
@ -359,6 +363,26 @@ checkdangling f = do
Left _ -> return () -- expected; dangling link Left _ -> return () -- expected; dangling link
Right _ -> assertFailure $ f ++ " was not a dangling link as expected" Right _ -> assertFailure $ f ++ " was not a dangling link as expected"
checklocationlog :: FilePath -> Bool -> Assertion
checklocationlog f expected = do
g <- Git.repoFromCwd
g' <- Git.configRead g
let thisuuid = Git.configGet g' "annex.uuid" ""
s <- Annex.new g BackendList.allBackends
r <- Annex.eval s $ Backend.lookupFile f
case r of
Just (k, _) -> do
uuids <- LocationLog.keyLocations g' k
assertEqual ("location log for " ++ f ++ " " ++ (show k) ++ " " ++ thisuuid)
expected (elem thisuuid uuids)
_ -> assertFailure $ f ++ " failed to look up key"
inlocationlog :: FilePath -> Assertion
inlocationlog f = checklocationlog f True
notinlocationlog :: FilePath -> Assertion
notinlocationlog f = checklocationlog f False
runchecks :: [FilePath -> Assertion] -> FilePath -> Assertion runchecks :: [FilePath -> Assertion] -> FilePath -> Assertion
runchecks [] _ = return () runchecks [] _ = return ()
runchecks (a:as) f = do runchecks (a:as) f = do
@ -366,10 +390,12 @@ runchecks (a:as) f = do
runchecks as f runchecks as f
annexed_notpresent :: FilePath -> Assertion annexed_notpresent :: FilePath -> Assertion
annexed_notpresent = runchecks [checklink, checkdangling, checkunwritable] annexed_notpresent = runchecks
[checklink, checkdangling, checkunwritable, notinlocationlog]
annexed_present :: FilePath -> Assertion annexed_present :: FilePath -> Assertion
annexed_present = runchecks [checklink, checkcontent, checkunwritable] annexed_present = runchecks
[checklink, checkcontent, checkunwritable, inlocationlog]
unannexed :: FilePath -> Assertion unannexed :: FilePath -> Assertion
unannexed = runchecks [checkregularfile, checkcontent, checkwritable] unannexed = runchecks [checkregularfile, checkcontent, checkwritable]