diff --git a/tests/Size.hs b/tests/Size.hs new file mode 100644 index 00000000..ce850cbc --- /dev/null +++ b/tests/Size.hs @@ -0,0 +1,100 @@ +{-# LANGUAGE CPP, GeneralizedNewtypeDeriving #-} + +-- | Tests for size field invariant in 'HashMap' wrapper introduced in GitHub +-- PR #170. + +module Main (main) where + +import Control.Monad.ST (ST) +#if defined(STRICT) +import qualified Data.HashMap.Strict as HM +#else +import qualified Data.HashMap.Lazy as HM +#endif +import Data.List (scanl') + +import Test.QuickCheck (Arbitrary, Property, conjoin, oneof) +import Test.Framework (Test, defaultMain, testGroup) + +-- Key type that generates more hash collisions. +newtype Key = K { unK :: Int } + deriving (Arbitrary, Eq, Ord, Read, Show) + +instance Hashable Key where + hashWithSalt salt k = hashWithSalt salt (unK k) `mod` 20 + +-- Datatype representing the actions that can potentially change a hashmap's +-- size modulo repetition i.e. 'mapMaybe' and 'filter' are essentially +-- equivalent in how they modify a hashmap, so only one ('filter') is tested. +data HashMapAction = + | Insert Key Int + | Delete Key + | Union (HM.HashMap Key Int) + | Intersection (HM.HashMap Key Int) + | Difference (HM.HashMap Key Int) + | Filter (Int -> Bool) + +instance Arbitrary HashMapAction where + arbitrary = oneof + [ Insert <$> arbitrary <*> arbitrary + , Delete <$> arbitrary + , Union <$> arbitrary + , Intersection <$> arbitrary + , Difference <$> arbitrary + , pure $ Filter even + ] + +-- Simple way of representing a hashmap and its size without having to +-- use 'size', which is the function to be tested. As such, its use is +-- avoided and the 'Int' field of the tuple is used instead. +type HashMapSt = (Int, HM.HashMap Key Int) + +-- | Applies a 'HashMapAction' to 'HashMapSt', updating the hashmap's +-- size after the operation. +applyActionToState :: HashMapSt -> HashMapAction -> HashMapSt +applyActionToState p@(sz, hm) (Insert k v) + | HM.member k hm = (sz + 1, HM.insert k v hm) + | otherwise = p +applyActionToState p@(sz, hm) (Delete k) + | HM.member k hm = p + Nothing -> p + | otherwise = (sz - 1, HM.delete k hm) +applyActionToState (sz, hm) (Union hm') = + let sz' = length $ HM.toList hm' + lenIntersect = length [ k | k <- HM.keys hm, HM.member k hm' ] + newLen = sz + sz' - lenIntersect + in (newLen, HM.union hm hm') +applyActionToState (sz, hm) (Intersection hm') = + let lenIntersect = length [ k | k <- HM.keys hm, HM.member k hm' ] + in (lenIntersect, HM.intersect hm hm') +applyActionToState (sz, hm) (Difference hm')= + let lenDiff = length [ k | k <- HM.keys hm, not $ HM.member k hm' ] + (lenDiff, HM.difference hm hm') +applyActionToState (sz, hm) (Filter pred) = + let lenFilter = length [ (k, v) | (k, v) <- HM.elems hm, pred v ] + in (lenFilter, HM.filter pred hm) + +-- | Property to check that after each operation that may change a hashmap's +-- size, the 'Int' field in the 'HashMap' wrapper always correctly represents +-- the hashmap's size. +sizeInvariantProperty :: [HashMapAction] -> Property +sizeInvariantProperty actionList = + conjoin . + map (\(sz, hm) -> sz == HM.size hm) . + scanl' applyActionToState (0, mempty) $ actionList + +------------------------------------------------------------------------ +-- * Test list + +tests :: [Test] +tests = [ + testGroup "size invariant checks" + [ sizeInvariantProperty + ] + ] + +------------------------------------------------------------------------ +-- * Test harness + +main :: IO () +main = defaultMain tests diff --git a/unordered-containers.cabal b/unordered-containers.cabal index 7008abbd..550be5f0 100644 --- a/unordered-containers.cabal +++ b/unordered-containers.cabal @@ -85,6 +85,23 @@ test-suite hashmap-strict-properties ghc-options: -Wall cpp-options: -DASSERTS -DSTRICT +test-suite hashmap-size-invariant + hs-source-dirs: tests + main-is: Size.hs + type: exitcode-stdio-1.0 + + build-depends: + base, + containers >= 0.4, + hashable >= 1.0.1.1, + QuickCheck >= 2.4.0.1, + test-framework >= 0.3.3, + test-framework-quickcheck2 >= 0.2.9, + unordered-containers + + ghc-options: -Wall + cpp-options: -DASSERTS -DSTRICT + test-suite hashset-properties hs-source-dirs: tests main-is: HashSetProperties.hs