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

fix metadata log simplifier and additional quickcheck tests

Browse source
This commit is contained in:
Joey Hess 2014-02-12 22:27:55 -04:00
parent 4d205b0fb9
commit a05ac13e92
3 changed files with 9 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

4
Logs/MetaData.hs
View file

@ -119,7 +119,7 @@ addMetaData k metadata = do
- -
- So, the only simplication that is actually done is to throw out an - So, the only simplication that is actually done is to throw out an
- old line when all the values in it have been overridden by lines that - old line when all the values in it have been overridden by lines that
- came before - came after.
-} -}
simplifyLog :: Log MetaData -> Log MetaData simplifyLog :: Log MetaData -> Log MetaData
simplifyLog s = case S.toDescList s of simplifyLog s = case S.toDescList s of
@ -128,7 +128,7 @@ simplifyLog s = case S.toDescList s of
where where
go c _ [] = c go c _ [] = c
go c newer (l:ls) go c newer (l:ls)
| older `hasUniqueMetaData` newer = | hasUniqueMetaData newer older =
go (l:c) (unionMetaData older newer) ls go (l:c) (unionMetaData older newer) ls
| otherwise = go c newer ls | otherwise = go c newer ls
where where

2
Test.hs
View file

@ -145,7 +145,7 @@ properties = localOption (QuickCheckTests 1000) $ testGroup "QuickCheck"
, testProperty "prop_hashes_stable" Utility.Hash.prop_hashes_stable , testProperty "prop_hashes_stable" Utility.Hash.prop_hashes_stable
, testProperty "prop_schedule_roundtrips" Utility.Scheduled.prop_schedule_roundtrips , testProperty "prop_schedule_roundtrips" Utility.Scheduled.prop_schedule_roundtrips
, testProperty "prop_duration_roundtrips" Utility.HumanTime.prop_duration_roundtrips , testProperty "prop_duration_roundtrips" Utility.HumanTime.prop_duration_roundtrips
, testProperty "prop_updateMetaData_sane" Types.MetaData.prop_updateMetaData_sane , testProperty "prop_metadata_sane" Types.MetaData.prop_metadata_sane
, testProperty "prop_metadata_serialize" Types.MetaData.prop_metadata_serialize , testProperty "prop_metadata_serialize" Types.MetaData.prop_metadata_serialize
] ]

9
Types/MetaData.hs
View file

@ -29,7 +29,7 @@ module Types.MetaData (
getAllMetaData, getAllMetaData,
serialize, serialize,
deserialize, deserialize,
prop_updateMetaData_sane, prop_metadata_sane,
prop_metadata_serialize prop_metadata_serialize
) where ) where
@ -199,10 +199,13 @@ instance Arbitrary MetaValue where
instance Arbitrary MetaField where instance Arbitrary MetaField where
arbitrary = MetaField <$> arbitrary `suchThat` legalField arbitrary = MetaField <$> arbitrary `suchThat` legalField
prop_updateMetaData_sane :: MetaData -> MetaField -> MetaValue -> Bool prop_metadata_sane :: MetaData -> MetaField -> MetaValue -> Bool
prop_updateMetaData_sane m f v = and prop_metadata_sane m f v = and
[ S.member v $ getAllMetaData f m' [ S.member v $ getAllMetaData f m'
, not (isSet v) || S.member v (currentMetaDataValues f m') , not (isSet v) || S.member v (currentMetaDataValues f m')
, not (hasUniqueMetaData m m)
, hasUniqueMetaData newMetaData m'
, not (hasUniqueMetaData m' newMetaData)
] ]
where where
m' = updateMetaData f v m m' = updateMetaData f v m