unordered-containers 0.2.16.0 → 0.2.17.0

raw patch · 23 files changed

+1285/−1314 lines, 23 filesdep +tastydep +tasty-benchdep +tasty-hunitdep −gaugedep −test-frameworkdep −test-framework-hunitdep ~basedep ~containersdep ~deepseqPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: tasty, tasty-bench, tasty-hunit, tasty-quickcheck, template-haskell

Dependencies removed: gauge, test-framework, test-framework-hunit, test-framework-quickcheck2

Dependency ranges changed: base, containers, deepseq, hashable

API changes (from Hackage documentation)

Files

• CHANGES.md +20/−0
• Data/HashMap/Internal.hs +89/−121
• Data/HashMap/Internal/Array.hs +50/−24
• Data/HashMap/Internal/List.hs +6/−4
• Data/HashMap/Internal/Strict.hs +24/−22
• Data/HashMap/Lazy.hs +4/−3
• Data/HashMap/Strict.hs +3/−2
• Data/HashSet.hs +2/−2
• Data/HashSet/Internal.hs +36/−42
• benchmarks/Benchmarks.hs +46/−28
• benchmarks/Util/ByteString.hs +2/−3
• tests/HashMapProperties.hs +0/−587
• tests/HashSetProperties.hs +0/−240
• tests/List.hs +0/−68
• tests/Main.hs +14/−0
• tests/Properties.hs +16/−0
• tests/Properties/HashMapLazy.hs +591/−0
• tests/Properties/HashMapStrict.hs +5/−0
• tests/Properties/HashSet.hs +236/−0
• tests/Properties/List.hs +64/−0
• tests/Regressions.hs +31/−36
• tests/Strictness.hs +17/−20
• unordered-containers.cabal +29/−112

@@ -1,3 +1,23 @@+## [0.2.17.0]++* [Define `dataCast1` for `HashMap`](https://github.com/haskell-unordered-containers/unordered-containers/pull/345)++* [Add `Lift` instances for Template Haskell](https://github.com/haskell-unordered-containers/unordered-containers/pull/343)++* [Add definitions for `stimes`](https://github.com/haskell-unordered-containers/unordered-containers/pull/340)++* [Expose internal constructors for `HashSet`, `Array` and `MArray`](https://github.com/haskell-unordered-containers/unordered-containers/pull/347)++* [Tweak internal `Array.insertM` function](https://github.com/haskell-unordered-containers/unordered-containers/pull/359)++* [Drop support for GHC 8.0](https://github.com/haskell-unordered-containers/unordered-containers/pull/354)++* [Drop support for `hashable < 1.2.5`](https://github.com/haskell-unordered-containers/unordered-containers/pull/355)++* Various cleanup and documentation improvements++[0.2.17.0]: https://github.com/haskell-unordered-containers/unordered-containers/compare/v0.2.16.0...v0.2.17.0+ ## [0.2.16.0]  * [Increase maximum branching factor from 16 to 32](https://github.com/haskell-unordered-containers/unordered-containers/pull/317)

@@ -1,14 +1,17 @@-{-# LANGUAGE BangPatterns, CPP, DeriveDataTypeable, MagicHash #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE PatternGuards #-}-{-# LANGUAGE RoleAnnotations #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE UnboxedTuples #-}-{-# LANGUAGE LambdaCase #-}-#if __GLASGOW_HASKELL__ >= 802-{-# LANGUAGE TypeInType #-}-{-# LANGUAGE UnboxedSums #-}-#endif+{-# LANGUAGE BangPatterns          #-}+{-# LANGUAGE CPP                   #-}+{-# LANGUAGE DeriveLift            #-}+{-# LANGUAGE LambdaCase            #-}+{-# LANGUAGE MagicHash             #-}+{-# LANGUAGE PatternGuards         #-}+{-# LANGUAGE RoleAnnotations       #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE StandaloneDeriving    #-}+{-# LANGUAGE TemplateHaskellQuotes #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE TypeInType            #-}+{-# LANGUAGE UnboxedSums           #-}+{-# LANGUAGE UnboxedTuples         #-} {-# OPTIONS_GHC -fno-full-laziness -funbox-strict-fields #-} {-# OPTIONS_HADDOCK not-home #-} @@ -137,49 +140,36 @@     , adjust#     ) where -#if !MIN_VERSION_base(4,11,0)-import Data.Semigroup (Semigroup((<>)))-#endif-import Control.DeepSeq (NFData(rnf))-import Control.Monad.ST (ST, runST)-import Data.Bits ((.&.), (.|.), complement, popCount, unsafeShiftL, unsafeShiftR)-import Data.Data hiding (Typeable)-import qualified Data.Foldable as Foldable-#if MIN_VERSION_base(4,10,0)-import Data.Bifoldable-#endif-import qualified Data.List as L-import GHC.Exts ((==#), build, reallyUnsafePtrEquality#, inline)-import Prelude hiding (filter, foldl, foldr, lookup, map, null, pred)-import Text.Read hiding (step)--import qualified Data.HashMap.Internal.Array as A-import qualified Data.Hashable as H-import Data.Hashable (Hashable)+import Control.Applicative        (Const (..))+import Control.DeepSeq            (NFData (..), NFData1 (..), NFData2 (..))+import Control.Monad.ST           (ST, runST)+import Data.Bifoldable            (Bifoldable (..))+import Data.Bits                  (complement, popCount, unsafeShiftL,+                                   unsafeShiftR, (.&.), (.|.))+import Data.Coerce                (coerce)+import Data.Data                  (Constr, Data (..), DataType)+import Data.Functor.Classes       (Eq1 (..), Eq2 (..), Ord1 (..), Ord2 (..),+                                   Read1 (..), Show1 (..), Show2 (..))+import Data.Functor.Identity      (Identity (..)) import Data.HashMap.Internal.List (isPermutationBy, unorderedCompare)-import Data.Typeable (Typeable)--import GHC.Exts (isTrue#)-import qualified GHC.Exts as Exts--import Data.Functor.Classes-import GHC.Stack--#if MIN_VERSION_hashable(1,2,5)-import qualified Data.Hashable.Lifted as H-#endif--#if MIN_VERSION_deepseq(1,4,3)-import qualified Control.DeepSeq as NF-#endif--#if __GLASGOW_HASKELL__ >= 802-import GHC.Exts (TYPE, Int (..), Int#)-#endif+import Data.Hashable              (Hashable)+import Data.Hashable.Lifted       (Hashable1, Hashable2)+import Data.Semigroup             (Semigroup (..), stimesIdempotentMonoid)+import GHC.Exts                   (Int (..), Int#, TYPE, (==#))+import GHC.Stack                  (HasCallStack)+import Prelude                    hiding (filter, foldl, foldr, lookup, map,+                                   null, pred)+import Text.Read                  hiding (step) -import Data.Functor.Identity (Identity (..))-import Control.Applicative (Const (..))-import Data.Coerce (coerce)+import qualified Data.Data                   as Data+import qualified Data.Foldable               as Foldable+import qualified Data.Functor.Classes        as FC+import qualified Data.HashMap.Internal.Array as A+import qualified Data.Hashable               as H+import qualified Data.Hashable.Lifted        as H+import qualified Data.List                   as List+import qualified GHC.Exts                    as Exts+import qualified Language.Haskell.TH.Syntax  as TH  -- | A set of values.  A set cannot contain duplicate values. ------------------------------------------------------------------------@@ -194,15 +184,21 @@ instance (NFData k, NFData v) => NFData (Leaf k v) where     rnf (L k v) = rnf k `seq` rnf v -#if MIN_VERSION_deepseq(1,4,3)+-- | @since 0.2.17.0+instance (TH.Lift k, TH.Lift v) => TH.Lift (Leaf k v) where+#if MIN_VERSION_template_haskell(2,16,0)+  liftTyped (L k v) = [|| L k $! v ||]+#else+  lift (L k v) = [| L k $! v |]+#endif+ -- | @since 0.2.14.0-instance NFData k => NF.NFData1 (Leaf k) where-    liftRnf rnf2 = NF.liftRnf2 rnf rnf2+instance NFData k => NFData1 (Leaf k) where+    liftRnf rnf2 = liftRnf2 rnf rnf2  -- | @since 0.2.14.0-instance NF.NFData2 Leaf where+instance NFData2 Leaf where     liftRnf2 rnf1 rnf2 (L k v) = rnf1 k `seq` rnf2 v-#endif  -- Invariant: The length of the 1st argument to 'Full' is -- 2^bitsPerSubkey@@ -215,10 +211,12 @@     | Leaf !Hash !(Leaf k v)     | Full !(A.Array (HashMap k v))     | Collision !Hash !(A.Array (Leaf k v))-      deriving (Typeable)  type role HashMap nominal representational +-- | @since 0.2.17.0+deriving instance (TH.Lift k, TH.Lift v) => TH.Lift (HashMap k v)+ instance (NFData k, NFData v) => NFData (HashMap k v) where     rnf Empty                 = ()     rnf (BitmapIndexed _ ary) = rnf ary@@ -226,19 +224,17 @@     rnf (Full ary)            = rnf ary     rnf (Collision _ ary)     = rnf ary -#if MIN_VERSION_deepseq(1,4,3) -- | @since 0.2.14.0-instance NFData k => NF.NFData1 (HashMap k) where-    liftRnf rnf2 = NF.liftRnf2 rnf rnf2+instance NFData k => NFData1 (HashMap k) where+    liftRnf rnf2 = liftRnf2 rnf rnf2  -- | @since 0.2.14.0-instance NF.NFData2 HashMap where+instance NFData2 HashMap where     liftRnf2 _ _ Empty                       = ()-    liftRnf2 rnf1 rnf2 (BitmapIndexed _ ary) = NF.liftRnf (NF.liftRnf2 rnf1 rnf2) ary-    liftRnf2 rnf1 rnf2 (Leaf _ l)            = NF.liftRnf2 rnf1 rnf2 l-    liftRnf2 rnf1 rnf2 (Full ary)            = NF.liftRnf (NF.liftRnf2 rnf1 rnf2) ary-    liftRnf2 rnf1 rnf2 (Collision _ ary)     = NF.liftRnf (NF.liftRnf2 rnf1 rnf2) ary-#endif+    liftRnf2 rnf1 rnf2 (BitmapIndexed _ ary) = liftRnf (liftRnf2 rnf1 rnf2) ary+    liftRnf2 rnf1 rnf2 (Leaf _ l)            = liftRnf2 rnf1 rnf2 l+    liftRnf2 rnf1 rnf2 (Full ary)            = liftRnf (liftRnf2 rnf1 rnf2) ary+    liftRnf2 rnf1 rnf2 (Collision _ ary)     = liftRnf (liftRnf2 rnf1 rnf2) ary  instance Functor (HashMap k) where     fmap = map@@ -259,7 +255,6 @@     length = size     {-# INLINE length #-} -#if MIN_VERSION_base(4,10,0) -- | @since 0.2.11 instance Bifoldable HashMap where     bifoldMap f g = foldMapWithKey (\ k v -> f k `mappend` g v)@@ -268,7 +263,6 @@     {-# INLINE bifoldr #-}     bifoldl f g = foldlWithKey (\ acc k v -> (acc `f` k) `g` v)     {-# INLINE bifoldl #-}-#endif  -- | '<>' = 'union' --@@ -281,6 +275,8 @@ instance (Eq k, Hashable k) => Semigroup (HashMap k v) where   (<>) = union   {-# INLINE (<>) #-}+  stimes = stimesIdempotentMonoid+  {-# INLINE stimes #-}  -- | 'mempty' = 'empty' --@@ -301,17 +297,18 @@ instance (Data k, Data v, Eq k, Hashable k) => Data (HashMap k v) where     gfoldl f z m   = z fromList `f` toList m     toConstr _     = fromListConstr-    gunfold k z c  = case constrIndex c of+    gunfold k z c  = case Data.constrIndex c of         1 -> k (z fromList)         _ -> error "gunfold"     dataTypeOf _   = hashMapDataType-    dataCast2 f    = gcast2 f+    dataCast1 f    = Data.gcast1 f+    dataCast2 f    = Data.gcast2 f  fromListConstr :: Constr-fromListConstr = mkConstr hashMapDataType "fromList" [] Prefix+fromListConstr = Data.mkConstr hashMapDataType "fromList" [] Data.Prefix  hashMapDataType :: DataType-hashMapDataType = mkDataType "Data.HashMap.Internal.HashMap" [fromListConstr]+hashMapDataType = Data.mkDataType "Data.HashMap.Internal.HashMap" [fromListConstr]  type Hash   = Word type Bitmap = Word@@ -319,7 +316,7 @@  instance Show2 HashMap where     liftShowsPrec2 spk slk spv slv d m =-        showsUnaryWith (liftShowsPrec sp sl) "fromList" d (toList m)+        FC.showsUnaryWith (liftShowsPrec sp sl) "fromList" d (toList m)       where         sp = liftShowsPrec2 spk slk spv slv         sl = liftShowList2 spk slk spv slv@@ -328,8 +325,8 @@     liftShowsPrec = liftShowsPrec2 showsPrec showList  instance (Eq k, Hashable k, Read k) => Read1 (HashMap k) where-    liftReadsPrec rp rl = readsData $-        readsUnaryWith (liftReadsPrec rp' rl') "fromList" fromList+    liftReadsPrec rp rl = FC.readsData $+        FC.readsUnaryWith (liftReadsPrec rp' rl') "fromList" fromList       where         rp' = liftReadsPrec rp rl         rl' = liftReadList rp rl@@ -452,7 +449,7 @@      leafCompare (L k v) (L k' v') = cmpk k k' `mappend` cmpv v v' --- Same as 'equal' but doesn't compare the values.+-- Same as 'equal2' but doesn't compare the values. equalKeys1 :: (k -> k' -> Bool) -> HashMap k v -> HashMap k' v' -> Bool equalKeys1 eq t1 t2 = go (toList' t1 []) (toList' t2 [])   where@@ -484,8 +481,7 @@      leafEq (L k1 _) (L k2 _) = k1 == k2 -#if MIN_VERSION_hashable(1,2,5)-instance H.Hashable2 HashMap where+instance Hashable2 HashMap where     liftHashWithSalt2 hk hv salt hm = go salt (toList' hm [])       where         -- go :: Int -> [HashMap k v] -> Int@@ -503,14 +499,13 @@          -- hashCollisionWithSalt :: Int -> A.Array (Leaf k v) -> Int         hashCollisionWithSalt s-          = L.foldl' H.hashWithSalt s . arrayHashesSorted s+          = List.foldl' H.hashWithSalt s . arrayHashesSorted s          -- arrayHashesSorted :: Int -> A.Array (Leaf k v) -> [Int]-        arrayHashesSorted s = L.sort . L.map (hashLeafWithSalt s) . A.toList+        arrayHashesSorted s = List.sort . List.map (hashLeafWithSalt s) . A.toList -instance (Hashable k) => H.Hashable1 (HashMap k) where+instance (Hashable k) => Hashable1 (HashMap k) where     liftHashWithSalt = H.liftHashWithSalt2 H.hashWithSalt-#endif  instance (Hashable k, Hashable v) => Hashable (HashMap k v) where     hashWithSalt salt hm = go salt hm@@ -531,10 +526,10 @@          hashCollisionWithSalt :: Int -> A.Array (Leaf k v) -> Int         hashCollisionWithSalt s-          = L.foldl' H.hashWithSalt s . arrayHashesSorted s+          = List.foldl' H.hashWithSalt s . arrayHashesSorted s          arrayHashesSorted :: Int -> A.Array (Leaf k v) -> [Int]-        arrayHashesSorted s = L.sort . L.map (hashLeafWithSalt s) . A.toList+        arrayHashesSorted s = List.sort . List.map (hashLeafWithSalt s) . A.toList    -- Helper to get 'Leaf's and 'Collision's as a list. toList' :: HashMap k v -> [HashMap k v] -> [HashMap k v]@@ -590,7 +585,6 @@ -- | /O(log n)/ Return the value to which the specified key is mapped, -- or 'Nothing' if this map contains no mapping for the key. lookup :: (Eq k, Hashable k) => k -> HashMap k v -> Maybe v-#if __GLASGOW_HASKELL__ >= 802 -- GHC does not yet perform a worker-wrapper transformation on -- unboxed sums automatically. That seems likely to happen at some -- point (possibly as early as GHC 8.6) but for now we do it manually.@@ -603,16 +597,9 @@ lookup# k m = lookupCont (\_ -> (# (# #) | #)) (\v _i -> (# | v #)) (hash k) k 0 m {-# INLINABLE lookup# #-} -#else--lookup k m = lookupCont (\_ -> Nothing) (\v _i -> Just v) (hash k) k 0 m-{-# INLINABLE lookup #-}-#endif- -- | lookup' is a version of lookup that takes the hash separately. -- It is used to implement alterF. lookup' :: Eq k => Hash -> k -> HashMap k v -> Maybe v-#if __GLASGOW_HASKELL__ >= 802 -- GHC does not yet perform a worker-wrapper transformation on -- unboxed sums automatically. That seems likely to happen at some -- point (possibly as early as GHC 8.6) but for now we do it manually.@@ -623,10 +610,6 @@   (# (# #) | #) -> Nothing   (# | (# a, _i #) #) -> Just a {-# INLINE lookup' #-}-#else-lookup' h k m = lookupCont (\_ -> Nothing) (\v _i -> Just v) h k 0 m-{-# INLINABLE lookup' #-}-#endif  -- The result of a lookup, keeping track of if a hash collision occured. -- If a collision did not occur then it will have the Int value (-1).@@ -646,7 +629,6 @@ --   Key in map, no collision => Present v (-1) --   Key in map, collision    => Present v position lookupRecordCollision :: Eq k => Hash -> k -> HashMap k v -> LookupRes v-#if __GLASGOW_HASKELL__ >= 802 lookupRecordCollision h k m = case lookupRecordCollision# h k m of   (# (# #) | #) -> Absent   (# | (# a, i #) #) -> Present a (I# i) -- GHC will eliminate the I#@@ -663,12 +645,6 @@ -- INLINABLE to specialize to the Eq instance. {-# INLINABLE lookupRecordCollision# #-} -#else /* GHC < 8.2 so there are no unboxed sums */--lookupRecordCollision h k m = lookupCont (\_ -> Absent) Present h k 0 m-{-# INLINABLE lookupRecordCollision #-}-#endif- -- A two-continuation version of lookupRecordCollision. This lets us -- share source code between lookup and lookupRecordCollision without -- risking any performance degradation.@@ -682,11 +658,7 @@ -- keys at the top-level of a hashmap, the offset should be 0. When looking up -- keys at level @n@ of a hashmap, the offset should be @n * bitsPerSubkey@. lookupCont ::-#if __GLASGOW_HASKELL__ >= 802   forall rep (r :: TYPE rep) k v.-#else-  forall r k v.-#endif      Eq k   => ((# #) -> r)    -- Absent continuation   -> (v -> Int -> r) -- Present continuation@@ -1435,7 +1407,7 @@ -- -- @since 0.2.12 isSubmapOf :: (Eq k, Hashable k, Eq v) => HashMap k v -> HashMap k v -> Bool-isSubmapOf = (inline isSubmapOfBy) (==)+isSubmapOf = (Exts.inline isSubmapOfBy) (==) {-# INLINABLE isSubmapOf #-}  -- | /O(n*log m)/ Inclusion of maps with value comparison. A map is included in@@ -1677,7 +1649,7 @@  -- | Construct a set containing all elements from a list of sets. unions :: (Eq k, Hashable k) => [HashMap k v] -> HashMap k v-unions = L.foldl' union empty+unions = List.foldl' union empty {-# INLINE unions #-}  @@ -2045,13 +2017,13 @@ -- | /O(n)/ Return a list of this map's keys.  The list is produced -- lazily. keys :: HashMap k v -> [k]-keys = L.map fst . toList+keys = List.map fst . toList {-# INLINE keys #-}  -- | /O(n)/ Return a list of this map's values.  The list is produced -- lazily. elems :: HashMap k v -> [v]-elems = L.map snd . toList+elems = List.map snd . toList {-# INLINE elems #-}  ------------------------------------------------------------------------@@ -2060,13 +2032,13 @@ -- | /O(n)/ Return a list of this map's elements.  The list is -- produced lazily. The order of its elements is unspecified. toList :: HashMap k v -> [(k, v)]-toList t = build (\ c z -> foldrWithKey (curry c) z t)+toList t = Exts.build (\ c z -> foldrWithKey (curry c) z t) {-# INLINE toList #-}  -- | /O(n)/ Construct a map with the supplied mappings.  If the list -- contains duplicate mappings, the later mappings take precedence. fromList :: (Eq k, Hashable k) => [(k, v)] -> HashMap k v-fromList = L.foldl' (\ m (k, v) -> unsafeInsert k v m) empty+fromList = List.foldl' (\ m (k, v) -> unsafeInsert k v m) empty {-# INLINABLE fromList #-}  -- | /O(n*log n)/ Construct a map from a list of elements.  Uses@@ -2100,7 +2072,7 @@ -- > fromListWith f [(k, a), (k, b), (k, c), (k, d)] -- > = fromList [(k, f d (f c (f b a)))] fromListWith :: (Eq k, Hashable k) => (v -> v -> v) -> [(k, v)] -> HashMap k v-fromListWith f = L.foldl' (\ m (k, v) -> unsafeInsertWith f k v m) empty+fromListWith f = List.foldl' (\ m (k, v) -> unsafeInsertWith f k v m) empty {-# INLINE fromListWith #-}  -- | /O(n*log n)/ Construct a map from a list of elements.  Uses@@ -2130,7 +2102,7 @@ -- -- @since 0.2.11 fromListWithKey :: (Eq k, Hashable k) => (k -> v -> v -> v) -> [(k, v)] -> HashMap k v-fromListWithKey f = L.foldl' (\ m (k, v) -> unsafeInsertWithKey f k v m) empty+fromListWithKey f = List.foldl' (\ m (k, v) -> unsafeInsertWithKey f k v m) empty {-# INLINE fromListWithKey #-}  ------------------------------------------------------------------------@@ -2139,11 +2111,7 @@ -- | /O(n)/ Look up the value associated with the given key in an -- array. lookupInArrayCont ::-#if __GLASGOW_HASKELL__ >= 802   forall rep (r :: TYPE rep) k v.-#else-  forall r k v.-#endif   Eq k => ((# #) -> r) -> (v -> Int -> r) -> k -> A.Array (Leaf k v) -> r lookupInArrayCont absent present k0 ary0 = go k0 ary0 0 (A.length ary0)   where@@ -2311,7 +2279,7 @@ -- | Check if two the two arguments are the same value.  N.B. This -- function might give false negatives (due to GC moving objects.) ptrEq :: a -> a -> Bool-ptrEq x y = isTrue# (reallyUnsafePtrEquality# x y ==# 1#)+ptrEq x y = Exts.isTrue# (Exts.reallyUnsafePtrEquality# x y ==# 1#) {-# INLINE ptrEq #-}  ------------------------------------------------------------------------

@@ -1,4 +1,10 @@-{-# LANGUAGE BangPatterns, CPP, MagicHash, Rank2Types, UnboxedTuples, ScopedTypeVariables #-}+{-# LANGUAGE BangPatterns          #-}+{-# LANGUAGE CPP                   #-}+{-# LANGUAGE MagicHash             #-}+{-# LANGUAGE Rank2Types            #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TemplateHaskellQuotes #-}+{-# LANGUAGE UnboxedTuples         #-} {-# OPTIONS_GHC -fno-full-laziness -funbox-strict-fields #-} {-# OPTIONS_HADDOCK not-home #-} @@ -20,8 +26,8 @@ -- -- Note that no bounds checking are performed. module Data.HashMap.Internal.Array-    ( Array-    , MArray+    ( Array(..)+    , MArray(..)        -- * Creation     , new@@ -69,31 +75,32 @@     , traverse'     , toList     , fromList+    , fromList'     ) where  import Control.Applicative (liftA2)-import Control.DeepSeq (NFData (..))-import GHC.Exts(Int(..), reallyUnsafePtrEquality#, tagToEnum#, unsafeCoerce#)-import GHC.ST (ST(..))-import Control.Monad.ST (runST, stToIO)--import Prelude hiding (filter, foldMap, foldr, foldl, length, map, read, traverse, all)--import GHC.Exts (SmallArray#, newSmallArray#, readSmallArray#, writeSmallArray#,-                 indexSmallArray#, unsafeFreezeSmallArray#, unsafeThawSmallArray#,-                 SmallMutableArray#, sizeofSmallArray#, copySmallArray#, thawSmallArray#,-                 sizeofSmallMutableArray#, copySmallMutableArray#, cloneSmallMutableArray#)+import Control.DeepSeq     (NFData (..), NFData1 (..))+import Control.Monad       ((>=>))+import Control.Monad.ST    (runST, stToIO)+import GHC.Exts            (Int (..), SmallArray#, SmallMutableArray#,+                            cloneSmallMutableArray#, copySmallArray#,+                            copySmallMutableArray#, indexSmallArray#,+                            newSmallArray#, readSmallArray#,+                            reallyUnsafePtrEquality#, sizeofSmallArray#,+                            sizeofSmallMutableArray#, tagToEnum#,+                            thawSmallArray#, unsafeCoerce#,+                            unsafeFreezeSmallArray#, unsafeThawSmallArray#,+                            writeSmallArray#)+import GHC.ST              (ST (..))+import Prelude             hiding (all, filter, foldMap, foldl, foldr, length,+                            map, read, traverse) +import qualified Language.Haskell.TH.Syntax as TH #if defined(ASSERTS) import qualified Prelude #endif -#if MIN_VERSION_deepseq(1,4,3)-import qualified Control.DeepSeq as NF-#endif -import Control.Monad ((>=>))- #if defined(ASSERTS) -- This fugly hack is brought by GHC's apparent reluctance to deal -- with MagicHash and UnboxedTuples when inferring types. Eek!@@ -169,9 +176,8 @@ -- relevant rnf is strict, or in case it actually isn't. {-# INLINE rnfArray #-} -#if MIN_VERSION_deepseq(1,4,3) -- | @since 0.2.14.0-instance NF.NFData1 Array where+instance NFData1 Array where     liftRnf = liftRnfArray  liftRnfArray :: (a -> ()) -> Array a -> ()@@ -183,7 +189,6 @@         | (# x #) <- index# ary i         = rnf0 x `seq` go ary n (i+1) {-# INLINE liftRnfArray #-}-#endif  -- | Create a new mutable array of specified size, in the specified -- state thread, with each element containing the specified initial@@ -303,9 +308,8 @@ insertM :: Array e -> Int -> e -> ST s (Array e) insertM ary idx b =     CHECK_BOUNDS("insertM", count + 1, idx)-        do mary <- new_ (count+1)+        do mary <- new (count+1) b            copy ary 0 mary 0 idx-           write mary idx b            copy ary idx mary (idx+1) (count-idx)            unsafeFreeze mary   where !count = length ary@@ -473,6 +477,28 @@     go [] !mary !_   = return mary     go (x:xs) mary i = do write mary i x                           go xs mary (i+1)++fromList' :: Int -> [a] -> Array a+fromList' n xs0 =+    CHECK_EQ("fromList'", n, Prelude.length xs0)+        run $ do+            mary <- new_ n+            go xs0 mary 0+  where+    go [] !mary !_   = return mary+    go (!x:xs) mary i = do write mary i x+                           go xs mary (i+1)++-- | @since 0.2.17.0+instance TH.Lift a => TH.Lift (Array a) where+#if MIN_VERSION_template_haskell(2,16,0)+  liftTyped ar = [|| fromList' arlen arlist ||]+#else+  lift ar = [| fromList' arlen arlist |]+#endif+    where+      arlen = length ar+      arlist = toList ar  toList :: Array a -> [a] toList = foldr (:) []

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP                 #-} {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-full-laziness -funbox-strict-fields #-} {-# OPTIONS_HADDOCK not-home #-}@@ -25,10 +26,11 @@     , unorderedCompare     ) where +import Data.List  (sortBy) import Data.Maybe (fromMaybe)-import Data.List (sortBy)-import Data.Monoid-import Prelude+#if !MIN_VERSION_base(4,11,0)+import Data.Semigroup ((<>))+#endif  -- Note: previous implemenation isPermutation = null (as // bs) -- was O(n^2) too.@@ -68,7 +70,7 @@     go [] [] = EQ     go [] (_ : _) = LT     go (_ : _) [] = GT-    go (x : xs) (y : ys) = c x y `mappend` go xs ys+    go (x : xs) (y : ys) = c x y <> go xs ys      cmpA a a' = compare (inB a) (inB a')     cmpB b b' = compare (inA b) (inA b')

@@ -1,6 +1,9 @@-{-# LANGUAGE BangPatterns, CPP, PatternGuards, MagicHash, UnboxedTuples #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE BangPatterns  #-}+{-# LANGUAGE CPP           #-}+{-# LANGUAGE MagicHash     #-}+{-# LANGUAGE PatternGuards #-}+{-# LANGUAGE Trustworthy   #-}+{-# LANGUAGE UnboxedTuples #-} {-# OPTIONS_HADDOCK not-home #-}  ------------------------------------------------------------------------@@ -118,24 +121,23 @@     , fromListWithKey     ) where -import Control.Monad.ST (runST)-import Data.Bits ((.&.), (.|.))--import qualified Data.List as L-import Data.Hashable (Hashable)-import Prelude hiding (map, lookup)+import Control.Applicative   (Const (..))+import Control.Monad.ST      (runST)+import Data.Bits             ((.&.), (.|.))+import Data.Coerce           (coerce)+import Data.Functor.Identity (Identity (..))+import Data.HashMap.Internal hiding (adjust, alter, alterF, differenceWith,+                              fromList, fromListWith, fromListWithKey, insert,+                              insertWith, intersectionWith, intersectionWithKey,+                              map, mapMaybe, mapMaybeWithKey, mapWithKey,+                              singleton, traverseWithKey, unionWith,+                              unionWithKey, update)+import Data.Hashable         (Hashable)+import Prelude               hiding (lookup, map) +import qualified Data.HashMap.Internal       as HM import qualified Data.HashMap.Internal.Array as A-import qualified Data.HashMap.Internal as HM-import Data.HashMap.Internal hiding (-    alter, alterF, adjust, fromList, fromListWith, fromListWithKey,-    insert, insertWith,-    differenceWith, intersectionWith, intersectionWithKey, map, mapWithKey,-    mapMaybe, mapMaybeWithKey, singleton, update, unionWith, unionWithKey,-    traverseWithKey)-import Data.Functor.Identity-import Control.Applicative (Const (..))-import Data.Coerce+import qualified Data.List                   as List  -- $strictness --@@ -628,7 +630,7 @@ -- list contains duplicate mappings, the later mappings take -- precedence. fromList :: (Eq k, Hashable k) => [(k, v)] -> HashMap k v-fromList = L.foldl' (\ m (k, !v) -> HM.unsafeInsert k v m) empty+fromList = List.foldl' (\ m (k, !v) -> HM.unsafeInsert k v m) empty {-# INLINABLE fromList #-}  -- | /O(n*log n)/ Construct a map from a list of elements.  Uses@@ -662,7 +664,7 @@ -- > fromListWith f [(k, a), (k, b), (k, c), (k, d)] -- > = fromList [(k, f d (f c (f b a)))] fromListWith :: (Eq k, Hashable k) => (v -> v -> v) -> [(k, v)] -> HashMap k v-fromListWith f = L.foldl' (\ m (k, v) -> unsafeInsertWith f k v m) empty+fromListWith f = List.foldl' (\ m (k, v) -> unsafeInsertWith f k v m) empty {-# INLINE fromListWith #-}  -- | /O(n*log n)/ Construct a map from a list of elements.  Uses@@ -692,7 +694,7 @@ -- -- @since 0.2.11 fromListWithKey :: (Eq k, Hashable k) => (k -> v -> v -> v) -> [(k, v)] -> HashMap k v-fromListWithKey f = L.foldl' (\ m (k, v) -> unsafeInsertWithKey f k v m) empty+fromListWithKey f = List.foldl' (\ m (k, v) -> unsafeInsertWithKey f k v m) empty {-# INLINE fromListWithKey #-}  ------------------------------------------------------------------------

@@ -1,4 +1,4 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP         #-} {-# LANGUAGE Trustworthy #-}  ------------------------------------------------------------------------@@ -106,9 +106,10 @@     , HS.keysSet     ) where -import Data.HashMap.Internal as HM+import Data.HashMap.Internal+import Prelude               ()+ import qualified Data.HashSet.Internal as HS-import Prelude ()  -- $strictness --

@@ -105,9 +105,10 @@     , HS.keysSet     ) where -import Data.HashMap.Internal.Strict as HM+import Data.HashMap.Internal.Strict+import Prelude                      ()+ import qualified Data.HashSet.Internal as HS-import Prelude ()  -- $strictness --

@@ -1,4 +1,4 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP  #-} {-# LANGUAGE Safe #-}  ------------------------------------------------------------------------@@ -137,4 +137,4 @@     ) where  import Data.HashSet.Internal-import Prelude ()+import Prelude               ()

@@ -1,7 +1,9 @@-{-# LANGUAGE CPP, DeriveDataTypeable #-}-{-# LANGUAGE RoleAnnotations #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP                #-}+{-# LANGUAGE DeriveLift         #-}+{-# LANGUAGE RoleAnnotations    #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE Trustworthy        #-}+{-# LANGUAGE TypeFamilies       #-} {-# OPTIONS_HADDOCK not-home #-}  ------------------------------------------------------------------------@@ -40,7 +42,7 @@  module Data.HashSet.Internal     (-      HashSet+      HashSet(..)      -- * Construction     , empty@@ -88,49 +90,41 @@     , keysSet     ) where -import Control.DeepSeq (NFData(..))-import Data.Data hiding (Typeable)+import Control.DeepSeq       (NFData (..), NFData1 (..), liftRnf2)+import Data.Data             (Constr, Data (..), DataType) import Data.Functor.Classes-import Data.HashMap.Internal-  ( HashMap, foldMapWithKey, foldlWithKey, foldrWithKey-  , equalKeys, equalKeys1)-import Data.Hashable (Hashable(hashWithSalt))-#if !MIN_VERSION_base(4,11,0)-import Data.Semigroup (Semigroup(..))-#endif-import GHC.Exts (build)-import qualified GHC.Exts as Exts-import Prelude hiding (filter, foldr, foldl, map, null)-import qualified Data.Foldable as Foldable-import qualified Data.HashMap.Internal as H-import qualified Data.List as List-import Data.Typeable (Typeable)+import Data.HashMap.Internal (HashMap, equalKeys, equalKeys1, foldMapWithKey,+                              foldlWithKey, foldrWithKey)+import Data.Hashable         (Hashable (hashWithSalt))+import Data.Hashable.Lifted  (Hashable1 (..), Hashable2 (..))+import Data.Semigroup        (Semigroup (..), stimesIdempotentMonoid)+import Prelude               hiding (filter, foldl, foldr, map, null) import Text.Read -#if MIN_VERSION_hashable(1,2,5)-import qualified Data.Hashable.Lifted as H-#endif--#if MIN_VERSION_deepseq(1,4,3)-import qualified Control.DeepSeq as NF-#endif+import qualified Data.Data                  as Data+import qualified Data.Foldable              as Foldable+import qualified Data.HashMap.Internal      as H+import qualified Data.List                  as List+import qualified GHC.Exts                   as Exts+import qualified Language.Haskell.TH.Syntax as TH  -- | A set of values.  A set cannot contain duplicate values. newtype HashSet a = HashSet {       asMap :: HashMap a ()-    } deriving (Typeable)+    }  type role HashSet nominal +-- | @since 0.2.17.0+deriving instance TH.Lift a => TH.Lift (HashSet a)+ instance (NFData a) => NFData (HashSet a) where     rnf = rnf . asMap     {-# INLINE rnf #-} -#if MIN_VERSION_deepseq(1,4,3) -- | @since 0.2.14.0-instance NF.NFData1 HashSet where-    liftRnf rnf1 = NF.liftRnf2 rnf1 rnf . asMap-#endif+instance NFData1 HashSet where+    liftRnf rnf1 = liftRnf2 rnf1 rnf . asMap  -- | Note that, in the presence of hash collisions, equal @HashSet@s may -- behave differently, i.e. substitutivity may be violated:@@ -195,6 +189,8 @@ instance (Hashable a, Eq a) => Semigroup (HashSet a) where     (<>) = union     {-# INLINE (<>) #-}+    stimes = stimesIdempotentMonoid+    {-# INLINE stimes #-}  -- | 'mempty' = 'empty' --@@ -234,25 +230,23 @@ instance (Data a, Eq a, Hashable a) => Data (HashSet a) where     gfoldl f z m   = z fromList `f` toList m     toConstr _     = fromListConstr-    gunfold k z c  = case constrIndex c of+    gunfold k z c  = case Data.constrIndex c of         1 -> k (z fromList)         _ -> error "gunfold"     dataTypeOf _   = hashSetDataType-    dataCast1 f    = gcast1 f+    dataCast1 f    = Data.gcast1 f -#if MIN_VERSION_hashable(1,2,6)-instance H.Hashable1 HashSet where-    liftHashWithSalt h s = H.liftHashWithSalt2 h hashWithSalt s . asMap-#endif+instance Hashable1 HashSet where+    liftHashWithSalt h s = liftHashWithSalt2 h hashWithSalt s . asMap  instance (Hashable a) => Hashable (HashSet a) where     hashWithSalt salt = hashWithSalt salt . asMap  fromListConstr :: Constr-fromListConstr = mkConstr hashSetDataType "fromList" [] Prefix+fromListConstr = Data.mkConstr hashSetDataType "fromList" [] Data.Prefix  hashSetDataType :: DataType-hashSetDataType = mkDataType "Data.HashSet.Internal.HashSet" [fromListConstr]+hashSetDataType = Data.mkDataType "Data.HashSet.Internal.HashSet" [fromListConstr]  -- | /O(1)/ Construct an empty set. --@@ -448,7 +442,7 @@ -- | /O(n)/ Return a list of this set's elements.  The list is -- produced lazily. toList :: HashSet a -> [a]-toList t = build (\ c z -> foldrWithKey ((const .) c) z (asMap t))+toList t = Exts.build (\ c z -> foldrWithKey ((const .) c) z (asMap t)) {-# INLINE toList #-}  -- | /O(n*min(W, n))/ Construct a set from a list of elements.

@@ -1,25 +1,30 @@-{-# LANGUAGE CPP, DeriveAnyClass, DeriveGeneric, GADTs, PackageImports, RecordWildCards #-}+{-# LANGUAGE CPP             #-}+{-# LANGUAGE DeriveAnyClass  #-}+{-# LANGUAGE DeriveGeneric   #-}+{-# LANGUAGE GADTs           #-}+{-# LANGUAGE PackageImports  #-}+{-# LANGUAGE RecordWildCards #-}  module Main where -import Control.DeepSeq-import Gauge (bench, bgroup, defaultMain, env, nf, whnf)-import Data.Bits ((.&.))-import Data.Functor.Identity-import Data.Hashable (Hashable, hash)-import qualified Data.ByteString as BS-import qualified "hashmap" Data.HashMap as IHM-import qualified Data.HashMap.Strict as HM-import qualified Data.IntMap as IM-import qualified Data.Map as M-import Data.List (foldl')-import Data.Maybe (fromMaybe)-import GHC.Generics (Generic)-import Prelude hiding (lookup)+import Control.DeepSeq       (NFData (..))+import Data.Bits             ((.&.))+import Data.Functor.Identity (Identity (..))+import Data.Hashable         (Hashable, hash)+import Data.List             (foldl')+import Data.Maybe            (fromMaybe)+import GHC.Generics          (Generic)+import Prelude               hiding (lookup)+import Test.Tasty.Bench      (bench, bgroup, defaultMain, env, nf, whnf) -import qualified Util.ByteString as UBS-import qualified Util.Int as UI-import qualified Util.String as US+import qualified Data.ByteString        as BS+import qualified "hashmap" Data.HashMap as IHM+import qualified Data.HashMap.Strict    as HM+import qualified Data.IntMap            as IM+import qualified Data.Map               as M+import qualified Util.ByteString        as UBS+import qualified Util.Int               as UI+import qualified Util.String            as US  data B where     B :: NFData a => a -> B@@ -121,6 +126,7 @@ main = do     defaultMain         [+#ifdef BENCH_containers_Map           env setupEnv $ \ ~(Env{..}) ->           -- * Comparison to other data structures           -- ** Map@@ -161,10 +167,12 @@             [ bench "String" $ whnf (M.isSubmapOf mSubset) m             , bench "ByteString" $ whnf (M.isSubmapOf mbsSubset) mbs             ]-          ]+          ],+#endif +#ifdef BENCH_hashmap_Map           -- ** Map from the hashmap package-        , env setupEnv $ \ ~(Env{..}) ->+          env setupEnv $ \ ~(Env{..}) ->           bgroup "hashmap/Map"           [ bgroup "lookup"             [ bench "String" $ whnf (lookupIHM keys) ihm@@ -202,14 +210,12 @@             [ bench "String" $ whnf (IHM.isSubmapOf ihmSubset) ihm             , bench "ByteString" $ whnf (IHM.isSubmapOf ihmbsSubset) ihmbs             ]-          , bgroup "hash"-            [ bench "String" $ whnf hash hm-            , bench "ByteString" $ whnf hash hmbs-            ]-          ]+          ],+#endif +#ifdef BENCH_containers_IntMap           -- ** IntMap-        , env setupEnv $ \ ~(Env{..}) ->+          env setupEnv $ \ ~(Env{..}) ->           bgroup "IntMap"           [ bench "lookup" $ whnf (lookupIM keysI) im           , bench "lookup-miss" $ whnf (lookupIM keysI') im@@ -220,9 +226,10 @@           , bench "size" $ whnf IM.size im           , bench "fromList" $ whnf IM.fromList elemsI           , bench "isSubmapOf" $ whnf (IM.isSubmapOf imSubset) im-          ]+          ],+#endif -        , env setupEnv $ \ ~(Env{..}) ->+          env setupEnv $ \ ~(Env{..}) ->           bgroup "HashMap"           [ -- * Basic interface             bgroup "lookup"@@ -357,6 +364,11 @@               , bench "Int" $ whnf (HM.fromListWith (+)) elemsDupI               ]             ]+            -- Hashable instance+          , bgroup "hash"+            [ bench "String" $ whnf hash hm+            , bench "ByteString" $ whnf hash hmbs+            ]           ]         ] @@ -438,6 +450,7 @@ {-# SPECIALIZE isSubmapOfNaive :: HM.HashMap String Int -> HM.HashMap String Int -> Bool #-} {-# SPECIALIZE isSubmapOfNaive :: HM.HashMap BS.ByteString Int -> HM.HashMap BS.ByteString Int -> Bool #-} +#ifdef BENCH_containers_Map ------------------------------------------------------------------------ -- * Map @@ -458,7 +471,9 @@ {-# SPECIALIZE deleteM :: [String] -> M.Map String Int -> M.Map String Int #-} {-# SPECIALIZE deleteM :: [BS.ByteString] -> M.Map BS.ByteString Int                        -> M.Map BS.ByteString Int #-}+#endif +#ifdef BENCH_hashmap_Map ------------------------------------------------------------------------ -- * Map from the hashmap package @@ -482,7 +497,9 @@                          -> IHM.Map String Int #-} {-# SPECIALIZE deleteIHM :: [BS.ByteString] -> IHM.Map BS.ByteString Int                          -> IHM.Map BS.ByteString Int #-}+#endif +#ifdef BENCH_containers_IntMap ------------------------------------------------------------------------ -- * IntMap @@ -494,3 +511,4 @@  deleteIM :: [Int] -> IM.IntMap Int -> IM.IntMap Int deleteIM xs m0 = foldl' (\m k -> IM.delete k m) m0 xs+#endif

@@ -2,10 +2,9 @@ -- random 'ByteString's. module Util.ByteString where -import qualified Data.ByteString as S+import qualified Data.ByteString       as S import qualified Data.ByteString.Char8 as C--import Util.String as String+import qualified Util.String           as String  -- | Generate a number of fixed length 'ByteString's where the content -- of the strings are letters in ascending order.

@@ -1,587 +0,0 @@-{-# LANGUAGE CPP, GeneralizedNewtypeDeriving #-}-{-# OPTIONS_GHC -fno-warn-orphans #-} -- because of Arbitrary (HashMap k v)---- | Tests for the 'Data.HashMap.Lazy' module.  We test functions by--- comparing them to a simpler model, an association list.--module Main (main) where--import Control.Monad ( guard )-import qualified Data.Foldable as Foldable-#if MIN_VERSION_base(4,10,0)-import Data.Bifoldable-#endif-import Data.Function (on)-import Data.Hashable (Hashable(hashWithSalt))-import qualified Data.List as L-import Data.Ord (comparing)-#if defined(STRICT)-import Data.HashMap.Strict (HashMap)-import qualified Data.HashMap.Strict as HM-import qualified Data.Map.Strict as M-#else-import Data.HashMap.Lazy (HashMap)-import qualified Data.HashMap.Lazy as HM-import qualified Data.Map.Lazy as M-#endif-import Test.QuickCheck (Arbitrary(..), Property, (==>), (===), forAll, elements)-import Test.Framework (Test, defaultMain, testGroup)-import Test.Framework.Providers.QuickCheck2 (testProperty)-import Data.Functor.Identity (Identity (..))-import Control.Applicative (Const (..))-import Test.QuickCheck.Function (Fun, apply)-import Test.QuickCheck.Poly (A, B)---- 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--instance (Eq k, Hashable k, Arbitrary k, Arbitrary v) => Arbitrary (HashMap k v) where-  arbitrary = fmap (HM.fromList) arbitrary----------------------------------------------------------------------------- * Properties----------------------------------------------------------------------------- ** Instances--pEq :: [(Key, Int)] -> [(Key, Int)] -> Bool-pEq xs = (M.fromList xs ==) `eq` (HM.fromList xs ==)--pNeq :: [(Key, Int)] -> [(Key, Int)] -> Bool-pNeq xs = (M.fromList xs /=) `eq` (HM.fromList xs /=)---- We cannot compare to `Data.Map` as ordering is different.-pOrd1 :: [(Key, Int)] -> Bool-pOrd1 xs = compare x x == EQ-  where-    x = HM.fromList xs--pOrd2 :: [(Key, Int)] -> [(Key, Int)] -> [(Key, Int)] -> Bool-pOrd2 xs ys zs = case (compare x y, compare y z) of-    (EQ, o)  -> compare x z == o-    (o,  EQ) -> compare x z == o-    (LT, LT) -> compare x z == LT-    (GT, GT) -> compare x z == GT-    (LT, GT) -> True -- ys greater than xs and zs.-    (GT, LT) -> True-  where-    x = HM.fromList xs-    y = HM.fromList ys-    z = HM.fromList zs--pOrd3 :: [(Key, Int)] -> [(Key, Int)] -> Bool-pOrd3 xs ys = case (compare x y, compare y x) of-    (EQ, EQ) -> True-    (LT, GT) -> True-    (GT, LT) -> True-    _        -> False-  where-    x = HM.fromList xs-    y = HM.fromList ys--pOrdEq :: [(Key, Int)] -> [(Key, Int)] -> Bool-pOrdEq xs ys = case (compare x y, x == y) of-    (EQ, True)  -> True-    (LT, False) -> True-    (GT, False) -> True-    _           -> False-  where-    x = HM.fromList xs-    y = HM.fromList ys--pReadShow :: [(Key, Int)] -> Bool-pReadShow xs = M.fromList xs == read (show (M.fromList xs))--pFunctor :: [(Key, Int)] -> Bool-pFunctor = fmap (+ 1) `eq_` fmap (+ 1)--pFoldable :: [(Int, Int)] -> Bool-pFoldable = (L.sort . Foldable.foldr (:) []) `eq`-            (L.sort . Foldable.foldr (:) [])--pHashable :: [(Key, Int)] -> [Int] -> Int -> Property-pHashable xs is salt =-    x == y ==> hashWithSalt salt x === hashWithSalt salt y-  where-    xs' = L.nubBy (\(k,_) (k',_) -> k == k') xs-    ys = shuffle is xs'-    x = HM.fromList xs'-    y = HM.fromList ys-    -- Shuffle the list using indexes in the second-    shuffle :: [Int] -> [a] -> [a]-    shuffle idxs = L.map snd-                 . L.sortBy (comparing fst)-                 . L.zip (idxs ++ [L.maximum (0:is) + 1 ..])----------------------------------------------------------------------------- ** Basic interface--pSize :: [(Key, Int)] -> Bool-pSize = M.size `eq` HM.size--pMember :: Key -> [(Key, Int)] -> Bool-pMember k = M.member k `eq` HM.member k--pLookup :: Key -> [(Key, Int)] -> Bool-pLookup k = M.lookup k `eq` HM.lookup k--pLookupOperator :: Key -> [(Key, Int)] -> Bool-pLookupOperator k = M.lookup k `eq` (HM.!? k)--pInsert :: Key -> Int -> [(Key, Int)] -> Bool-pInsert k v = M.insert k v `eq_` HM.insert k v--pDelete :: Key -> [(Key, Int)] -> Bool-pDelete k = M.delete k `eq_` HM.delete k--newtype AlwaysCollide = AC Int-    deriving (Arbitrary, Eq, Ord, Show)--instance Hashable AlwaysCollide where-    hashWithSalt _ _ = 1---- White-box test that tests the case of deleting one of two keys from--- a map, where the keys' hash values collide.-pDeleteCollision :: AlwaysCollide -> AlwaysCollide -> AlwaysCollide -> Int-                 -> Property-pDeleteCollision k1 k2 k3 idx = (k1 /= k2) && (k2 /= k3) && (k1 /= k3) ==>-                                HM.member toKeep $ HM.delete toDelete $-                                HM.fromList [(k1, 1 :: Int), (k2, 2), (k3, 3)]-  where-    which = idx `mod` 3-    toDelete-        | which == 0 = k1-        | which == 1 = k2-        | which == 2 = k3-        | otherwise = error "Impossible"-    toKeep-        | which == 0 = k2-        | which == 1 = k3-        | which == 2 = k1-        | otherwise = error "Impossible"--pInsertWith :: Key -> [(Key, Int)] -> Bool-pInsertWith k = M.insertWith (+) k 1 `eq_` HM.insertWith (+) k 1--pAdjust :: Key -> [(Key, Int)] -> Bool-pAdjust k = M.adjust succ k `eq_` HM.adjust succ k--pUpdateAdjust :: Key -> [(Key, Int)] -> Bool-pUpdateAdjust k = M.update (Just . succ) k `eq_` HM.update (Just . succ) k--pUpdateDelete :: Key -> [(Key, Int)] -> Bool-pUpdateDelete k = M.update (const Nothing) k `eq_` HM.update (const Nothing) k--pAlterAdjust :: Key -> [(Key, Int)] -> Bool-pAlterAdjust k = M.alter (fmap succ) k `eq_` HM.alter (fmap succ) k--pAlterInsert :: Key -> [(Key, Int)] -> Bool-pAlterInsert k = M.alter (const $ Just 3) k `eq_` HM.alter (const $ Just 3) k--pAlterDelete :: Key -> [(Key, Int)] -> Bool-pAlterDelete k = M.alter (const Nothing) k `eq_` HM.alter (const Nothing) k----- We choose the list functor here because we don't fuss with--- it in alterF rules and because it has a sufficiently interesting--- structure to have a good chance of breaking if something is wrong.-pAlterF :: Key -> Fun (Maybe A) [Maybe A] -> [(Key, A)] -> Property-pAlterF k f xs =-  fmap M.toAscList (M.alterF (apply f) k (M.fromList xs))-  ===-  fmap toAscList (HM.alterF (apply f) k (HM.fromList xs))--pAlterFAdjust :: Key -> [(Key, Int)] -> Bool-pAlterFAdjust k =-  runIdentity . M.alterF (Identity . fmap succ) k `eq_`-  runIdentity . HM.alterF (Identity . fmap succ) k--pAlterFInsert :: Key -> [(Key, Int)] -> Bool-pAlterFInsert k =-  runIdentity . M.alterF (const . Identity . Just $ 3) k `eq_`-  runIdentity . HM.alterF (const . Identity . Just $ 3) k--pAlterFInsertWith :: Key -> Fun Int Int -> [(Key, Int)] -> Bool-pAlterFInsertWith k f =-  runIdentity . M.alterF (Identity . Just . maybe 3 (apply f)) k `eq_`-  runIdentity . HM.alterF (Identity . Just . maybe 3 (apply f)) k--pAlterFDelete :: Key -> [(Key, Int)] -> Bool-pAlterFDelete k =-  runIdentity . M.alterF (const (Identity Nothing)) k `eq_`-  runIdentity . HM.alterF (const (Identity Nothing)) k--pAlterFLookup :: Key-              -> Fun (Maybe A) B-              -> [(Key, A)] -> Bool-pAlterFLookup k f =-  getConst . M.alterF (Const . apply f :: Maybe A -> Const B (Maybe A)) k-  `eq`-  getConst . HM.alterF (Const . apply f) k--pSubmap :: [(Key, Int)] -> [(Key, Int)] -> Bool-pSubmap xs ys = M.isSubmapOf (M.fromList xs) (M.fromList ys) ==-                HM.isSubmapOf (HM.fromList xs) (HM.fromList ys)--pSubmapReflexive :: HashMap Key Int -> Bool-pSubmapReflexive m = HM.isSubmapOf m m--pSubmapUnion :: HashMap Key Int -> HashMap Key Int -> Bool-pSubmapUnion m1 m2 = HM.isSubmapOf m1 (HM.union m1 m2)--pNotSubmapUnion :: HashMap Key Int -> HashMap Key Int -> Property-pNotSubmapUnion m1 m2 = not (HM.isSubmapOf m1 m2) ==> HM.isSubmapOf m1 (HM.union m1 m2)--pSubmapDifference :: HashMap Key Int -> HashMap Key Int -> Bool-pSubmapDifference m1 m2 = HM.isSubmapOf (HM.difference m1 m2) m1--pNotSubmapDifference :: HashMap Key Int -> HashMap Key Int -> Property-pNotSubmapDifference m1 m2 =-  not (HM.null (HM.intersection m1 m2)) ==>-  not (HM.isSubmapOf m1 (HM.difference m1 m2))--pSubmapDelete :: HashMap Key Int -> Property-pSubmapDelete m = not (HM.null m) ==>-  forAll (elements (HM.keys m)) $ \k ->-  HM.isSubmapOf (HM.delete k m) m--pNotSubmapDelete :: HashMap Key Int -> Property-pNotSubmapDelete m =-  not (HM.null m) ==>-  forAll (elements (HM.keys m)) $ \k ->-  not (HM.isSubmapOf m (HM.delete k m))--pSubmapInsert :: Key -> Int -> HashMap Key Int -> Property-pSubmapInsert k v m = not (HM.member k m) ==> HM.isSubmapOf m (HM.insert k v m)--pNotSubmapInsert :: Key -> Int -> HashMap Key Int -> Property-pNotSubmapInsert k v m = not (HM.member k m) ==> not (HM.isSubmapOf (HM.insert k v m) m)----------------------------------------------------------------------------- ** Combine--pUnion :: [(Key, Int)] -> [(Key, Int)] -> Bool-pUnion xs ys = M.union (M.fromList xs) `eq_` HM.union (HM.fromList xs) $ ys--pUnionWith :: [(Key, Int)] -> [(Key, Int)] -> Bool-pUnionWith xs ys = M.unionWith (-) (M.fromList xs) `eq_`-                   HM.unionWith (-) (HM.fromList xs) $ ys--pUnionWithKey :: [(Key, Int)] -> [(Key, Int)] -> Bool-pUnionWithKey xs ys = M.unionWithKey go (M.fromList xs) `eq_`-                             HM.unionWithKey go (HM.fromList xs) $ ys-  where-    go :: Key -> Int -> Int -> Int-    go (K k) i1 i2 = k - i1 + i2--pUnions :: [[(Key, Int)]] -> Bool-pUnions xss = M.toAscList (M.unions (map M.fromList xss)) ==-              toAscList (HM.unions (map HM.fromList xss))----------------------------------------------------------------------------- ** Transformations--pMap :: [(Key, Int)] -> Bool-pMap = M.map (+ 1) `eq_` HM.map (+ 1)--pTraverse :: [(Key, Int)] -> Bool-pTraverse xs =-  L.sort (fmap (L.sort . M.toList) (M.traverseWithKey (\_ v -> [v + 1, v + 2]) (M.fromList (take 10 xs))))-     == L.sort (fmap (L.sort . HM.toList) (HM.traverseWithKey (\_ v -> [v + 1, v + 2]) (HM.fromList (take 10 xs))))--pMapKeys :: [(Int, Int)] -> Bool-pMapKeys = M.mapKeys (+1) `eq_` HM.mapKeys (+1)----------------------------------------------------------------------------- ** Difference and intersection--pDifference :: [(Key, Int)] -> [(Key, Int)] -> Bool-pDifference xs ys = M.difference (M.fromList xs) `eq_`-                    HM.difference (HM.fromList xs) $ ys--pDifferenceWith :: [(Key, Int)] -> [(Key, Int)] -> Bool-pDifferenceWith xs ys = M.differenceWith f (M.fromList xs) `eq_`-                        HM.differenceWith f (HM.fromList xs) $ ys-  where-    f x y = if x == 0 then Nothing else Just (x - y)--pIntersection :: [(Key, Int)] -> [(Key, Int)] -> Bool-pIntersection xs ys = M.intersection (M.fromList xs) `eq_`-                      HM.intersection (HM.fromList xs) $ ys--pIntersectionWith :: [(Key, Int)] -> [(Key, Int)] -> Bool-pIntersectionWith xs ys = M.intersectionWith (-) (M.fromList xs) `eq_`-                          HM.intersectionWith (-) (HM.fromList xs) $ ys--pIntersectionWithKey :: [(Key, Int)] -> [(Key, Int)] -> Bool-pIntersectionWithKey xs ys = M.intersectionWithKey go (M.fromList xs) `eq_`-                             HM.intersectionWithKey go (HM.fromList xs) $ ys-  where-    go :: Key -> Int -> Int -> Int-    go (K k) i1 i2 = k - i1 - i2----------------------------------------------------------------------------- ** Folds--pFoldr :: [(Int, Int)] -> Bool-pFoldr = (L.sort . M.foldr (:) []) `eq` (L.sort . HM.foldr (:) [])--pFoldl :: [(Int, Int)] -> Bool-pFoldl = (L.sort . M.foldl (flip (:)) []) `eq` (L.sort . HM.foldl (flip (:)) [])--#if MIN_VERSION_base(4,10,0)-pBifoldMap :: [(Int, Int)] -> Bool-pBifoldMap xs = concatMap f (HM.toList m) == bifoldMap (:[]) (:[]) m-  where f (k, v) = [k, v]-        m = HM.fromList xs--pBifoldr :: [(Int, Int)] -> Bool-pBifoldr xs = concatMap f (HM.toList m) == bifoldr (:) (:) [] m-  where f (k, v) = [k, v]-        m = HM.fromList xs--pBifoldl :: [(Int, Int)] -> Bool-pBifoldl xs = reverse (concatMap f $ HM.toList m) == bifoldl (flip (:)) (flip (:)) [] m-  where f (k, v) = [k, v]-        m = HM.fromList xs-#endif--pFoldrWithKey :: [(Int, Int)] -> Bool-pFoldrWithKey = (sortByKey . M.foldrWithKey f []) `eq`-                (sortByKey . HM.foldrWithKey f [])-  where f k v z = (k, v) : z--pFoldMapWithKey :: [(Int, Int)] -> Bool-pFoldMapWithKey = (sortByKey . M.foldMapWithKey f) `eq`-                  (sortByKey . HM.foldMapWithKey f)-  where f k v = [(k, v)]--pFoldrWithKey' :: [(Int, Int)] -> Bool-pFoldrWithKey' = (sortByKey . M.foldrWithKey' f []) `eq`-                 (sortByKey . HM.foldrWithKey' f [])-  where f k v z = (k, v) : z--pFoldlWithKey :: [(Int, Int)] -> Bool-pFoldlWithKey = (sortByKey . M.foldlWithKey f []) `eq`-                (sortByKey . HM.foldlWithKey f [])-  where f z k v = (k, v) : z--pFoldlWithKey' :: [(Int, Int)] -> Bool-pFoldlWithKey' = (sortByKey . M.foldlWithKey' f []) `eq`-                 (sortByKey . HM.foldlWithKey' f [])-  where f z k v = (k, v) : z--pFoldl' :: [(Int, Int)] -> Bool-pFoldl' = (L.sort . M.foldl' (flip (:)) []) `eq` (L.sort . HM.foldl' (flip (:)) [])--pFoldr' :: [(Int, Int)] -> Bool-pFoldr' = (L.sort . M.foldr' (:) []) `eq` (L.sort . HM.foldr' (:) [])----------------------------------------------------------------------------- ** Filter--pMapMaybeWithKey :: [(Key, Int)] -> Bool-pMapMaybeWithKey = M.mapMaybeWithKey f `eq_` HM.mapMaybeWithKey f-  where f k v = guard (odd (unK k + v)) >> Just (v + 1)--pMapMaybe :: [(Key, Int)] -> Bool-pMapMaybe = M.mapMaybe f `eq_` HM.mapMaybe f-  where f v = guard (odd v) >> Just (v + 1)--pFilter :: [(Key, Int)] -> Bool-pFilter = M.filter odd `eq_` HM.filter odd--pFilterWithKey :: [(Key, Int)] -> Bool-pFilterWithKey = M.filterWithKey p `eq_` HM.filterWithKey p-  where p k v = odd (unK k + v)----------------------------------------------------------------------------- ** Conversions---- The free magma is used to test that operations are applied in the--- same order.-data Magma a-  = Leaf a-  | Op (Magma a) (Magma a)-  deriving (Show, Eq, Ord)--instance Hashable a => Hashable (Magma a) where-  hashWithSalt s (Leaf a) = hashWithSalt s (hashWithSalt (1::Int) a)-  hashWithSalt s (Op m n) = hashWithSalt s (hashWithSalt (hashWithSalt (2::Int) m) n)---- 'eq_' already calls fromList.-pFromList :: [(Key, Int)] -> Bool-pFromList = id `eq_` id--pFromListWith :: [(Key, Int)] -> Bool-pFromListWith kvs = (M.toAscList $ M.fromListWith Op kvsM) ==-                    (toAscList $ HM.fromListWith Op kvsM)-  where kvsM = fmap (fmap Leaf) kvs--pFromListWithKey :: [(Key, Int)] -> Bool-pFromListWithKey kvs = (M.toAscList $ M.fromListWithKey combine kvsM) ==-                       (toAscList $ HM.fromListWithKey combine kvsM)-  where kvsM = fmap (\(K k,v) -> (Leaf k, Leaf v)) kvs-        combine k v1 v2 = Op k (Op v1 v2)--pToList :: [(Key, Int)] -> Bool-pToList = M.toAscList `eq` toAscList--pElems :: [(Key, Int)] -> Bool-pElems = (L.sort . M.elems) `eq` (L.sort . HM.elems)--pKeys :: [(Key, Int)] -> Bool-pKeys = (L.sort . M.keys) `eq` (L.sort . HM.keys)----------------------------------------------------------------------------- * Test list--tests :: [Test]-tests =-    [-    -- Instances-      testGroup "instances"-      [ testProperty "==" pEq-      , testProperty "/=" pNeq-      , testProperty "compare reflexive" pOrd1-      , testProperty "compare transitive" pOrd2-      , testProperty "compare antisymmetric" pOrd3-      , testProperty "Ord => Eq" pOrdEq-      , testProperty "Read/Show" pReadShow-      , testProperty "Functor" pFunctor-      , testProperty "Foldable" pFoldable-      , testProperty "Hashable" pHashable-      ]-    -- Basic interface-    , testGroup "basic interface"-      [ testProperty "size" pSize-      , testProperty "member" pMember-      , testProperty "lookup" pLookup-      , testProperty "!?" pLookupOperator-      , testProperty "insert" pInsert-      , testProperty "delete" pDelete-      , testProperty "deleteCollision" pDeleteCollision-      , testProperty "insertWith" pInsertWith-      , testProperty "adjust" pAdjust-      , testProperty "updateAdjust" pUpdateAdjust-      , testProperty "updateDelete" pUpdateDelete-      , testProperty "alterAdjust" pAlterAdjust-      , testProperty "alterInsert" pAlterInsert-      , testProperty "alterDelete" pAlterDelete-      , testProperty "alterF" pAlterF-      , testProperty "alterFAdjust" pAlterFAdjust-      , testProperty "alterFInsert" pAlterFInsert-      , testProperty "alterFInsertWith" pAlterFInsertWith-      , testProperty "alterFDelete" pAlterFDelete-      , testProperty "alterFLookup" pAlterFLookup-      , testGroup "isSubmapOf"-        [ testProperty "container compatibility" pSubmap-        , testProperty "m ⊆ m" pSubmapReflexive-        , testProperty "m1 ⊆ m1 ∪ m2" pSubmapUnion-        , testProperty "m1 ⊈ m2  ⇒  m1 ∪ m2 ⊈ m1" pNotSubmapUnion-        , testProperty "m1\\m2 ⊆ m1" pSubmapDifference-        , testProperty "m1 ∩ m2 ≠ ∅  ⇒  m1 ⊈ m1\\m2 " pNotSubmapDifference-        , testProperty "delete k m ⊆ m" pSubmapDelete-        , testProperty "m ⊈ delete k m " pNotSubmapDelete-        , testProperty "k ∉ m  ⇒  m ⊆ insert k v m" pSubmapInsert-        , testProperty "k ∉ m  ⇒  insert k v m ⊈ m" pNotSubmapInsert-        ]-      ]-    -- Combine-    , testProperty "union" pUnion-    , testProperty "unionWith" pUnionWith-    , testProperty "unionWithKey" pUnionWithKey-    , testProperty "unions" pUnions-    -- Transformations-    , testProperty "map" pMap-    , testProperty "traverse" pTraverse-    , testProperty "mapKeys" pMapKeys-    -- Folds-    , testGroup "folds"-      [ testProperty "foldr" pFoldr-      , testProperty "foldl" pFoldl-#if MIN_VERSION_base(4,10,0)-      , testProperty "bifoldMap" pBifoldMap-      , testProperty "bifoldr" pBifoldr-      , testProperty "bifoldl" pBifoldl-#endif-      , testProperty "foldrWithKey" pFoldrWithKey-      , testProperty "foldlWithKey" pFoldlWithKey-      , testProperty "foldrWithKey'" pFoldrWithKey'-      , testProperty "foldlWithKey'" pFoldlWithKey'-      , testProperty "foldl'" pFoldl'-      , testProperty "foldr'" pFoldr'-      , testProperty "foldMapWithKey" pFoldMapWithKey-      ]-    , testGroup "difference and intersection"-      [ testProperty "difference" pDifference-      , testProperty "differenceWith" pDifferenceWith-      , testProperty "intersection" pIntersection-      , testProperty "intersectionWith" pIntersectionWith-      , testProperty "intersectionWithKey" pIntersectionWithKey-      ]-    -- Filter-    , testGroup "filter"-      [ testProperty "filter" pFilter-      , testProperty "filterWithKey" pFilterWithKey-      , testProperty "mapMaybe" pMapMaybe-      , testProperty "mapMaybeWithKey" pMapMaybeWithKey-      ]-    -- Conversions-    , testGroup "conversions"-      [ testProperty "elems" pElems-      , testProperty "keys" pKeys-      , testProperty "fromList" pFromList-      , testProperty "fromListWith" pFromListWith-      , testProperty "fromListWithKey" pFromListWithKey-      , testProperty "toList" pToList-      ]-    ]----------------------------------------------------------------------------- * Model--type Model k v = M.Map k v---- | Check that a function operating on a 'HashMap' is equivalent to--- one operating on a 'Model'.-eq :: (Eq a, Eq k, Hashable k, Ord k)-   => (Model k v -> a)       -- ^ Function that modifies a 'Model'-   -> (HM.HashMap k v -> a)  -- ^ Function that modified a 'HashMap' in the same-                             -- way-   -> [(k, v)]               -- ^ Initial content of the 'HashMap' and 'Model'-   -> Bool                   -- ^ True if the functions are equivalent-eq f g xs = g (HM.fromList xs) == f (M.fromList xs)--infix 4 `eq`--eq_ :: (Eq k, Eq v, Hashable k, Ord k)-    => (Model k v -> Model k v)            -- ^ Function that modifies a 'Model'-    -> (HM.HashMap k v -> HM.HashMap k v)  -- ^ Function that modified a-                                           -- 'HashMap' in the same way-    -> [(k, v)]                            -- ^ Initial content of the 'HashMap'-                                           -- and 'Model'-    -> Bool                                -- ^ True if the functions are-                                           -- equivalent-eq_ f g = (M.toAscList . f) `eq` (toAscList . g)--infix 4 `eq_`----------------------------------------------------------------------------- * Test harness--main :: IO ()-main = defaultMain tests----------------------------------------------------------------------------- * Helpers--sortByKey :: Ord k => [(k, v)] -> [(k, v)]-sortByKey = L.sortBy (compare `on` fst)--toAscList :: Ord k => HM.HashMap k v -> [(k, v)]-toAscList = L.sortBy (compare `on` fst) . HM.toList

@@ -1,240 +0,0 @@-{-# LANGUAGE CPP, GeneralizedNewtypeDeriving #-}---- | Tests for the 'Data.HashSet' module.  We test functions by--- comparing them to a simpler model, a list.--module Main (main) where--import qualified Data.Foldable as Foldable-import Data.Hashable (Hashable(hashWithSalt))-import qualified Data.List as L-import qualified Data.HashSet as S-import qualified Data.Set as Set-import Data.Ord (comparing)-import Test.QuickCheck (Arbitrary, Property, (==>), (===))-import Test.Framework (Test, defaultMain, testGroup)-import Test.Framework.Providers.QuickCheck2 (testProperty)---- Key type that generates more hash collisions.-newtype Key = K { unK :: Int }-            deriving (Arbitrary, Enum, Eq, Integral, Num, Ord, Read, Show, Real)--instance Hashable Key where-    hashWithSalt salt k = hashWithSalt salt (unK k) `mod` 20----------------------------------------------------------------------------- * Properties----------------------------------------------------------------------------- ** Instances--pEq :: [Key] -> [Key] -> Bool-pEq xs = (Set.fromList xs ==) `eq` (S.fromList xs ==)--pNeq :: [Key] -> [Key] -> Bool-pNeq xs = (Set.fromList xs /=) `eq` (S.fromList xs /=)---- We cannot compare to `Data.Map` as ordering is different.-pOrd1 :: [Key] -> Bool-pOrd1 xs = compare x x == EQ-  where-    x = S.fromList xs--pOrd2 :: [Key] -> [Key] -> [Key] -> Bool-pOrd2 xs ys zs = case (compare x y, compare y z) of-    (EQ, o)  -> compare x z == o-    (o,  EQ) -> compare x z == o-    (LT, LT) -> compare x z == LT-    (GT, GT) -> compare x z == GT-    (LT, GT) -> True -- ys greater than xs and zs.-    (GT, LT) -> True-  where-    x = S.fromList xs-    y = S.fromList ys-    z = S.fromList zs--pOrd3 :: [Key] -> [Key] -> Bool-pOrd3 xs ys = case (compare x y, compare y x) of-    (EQ, EQ) -> True-    (LT, GT) -> True-    (GT, LT) -> True-    _        -> False-  where-    x = S.fromList xs-    y = S.fromList ys--pOrdEq :: [Key] -> [Key] -> Bool-pOrdEq xs ys = case (compare x y, x == y) of-    (EQ, True)  -> True-    (LT, False) -> True-    (GT, False) -> True-    _           -> False-  where-    x = S.fromList xs-    y = S.fromList ys--pReadShow :: [Key] -> Bool-pReadShow xs = Set.fromList xs == read (show (Set.fromList xs))--pFoldable :: [Int] -> Bool-pFoldable = (L.sort . Foldable.foldr (:) []) `eq`-            (L.sort . Foldable.foldr (:) [])--pPermutationEq :: [Key] -> [Int] -> Bool-pPermutationEq xs is = S.fromList xs == S.fromList ys-  where-    ys = shuffle is xs-    shuffle idxs = L.map snd-                 . L.sortBy (comparing fst)-                 . L.zip (idxs ++ [L.maximum (0:is) + 1 ..])--pHashable :: [Key] -> [Int] -> Int -> Property-pHashable xs is salt =-    x == y ==> hashWithSalt salt x === hashWithSalt salt y-  where-    xs' = L.nub xs-    ys = shuffle is xs'-    x = S.fromList xs'-    y = S.fromList ys-    shuffle idxs = L.map snd-                 . L.sortBy (comparing fst)-                 . L.zip (idxs ++ [L.maximum (0:is) + 1 ..])----------------------------------------------------------------------------- ** Basic interface--pSize :: [Key] -> Bool-pSize = Set.size `eq` S.size--pMember :: Key -> [Key] -> Bool-pMember k = Set.member k `eq` S.member k--pInsert :: Key -> [Key] -> Bool-pInsert a = Set.insert a `eq_` S.insert a--pDelete :: Key -> [Key] -> Bool-pDelete a = Set.delete a `eq_` S.delete a----------------------------------------------------------------------------- ** Combine--pUnion :: [Key] -> [Key] -> Bool-pUnion xs ys = Set.union (Set.fromList xs) `eq_`-               S.union (S.fromList xs) $ ys----------------------------------------------------------------------------- ** Transformations--pMap :: [Key] -> Bool-pMap = Set.map (+ 1) `eq_` S.map (+ 1)----------------------------------------------------------------------------- ** Folds--pFoldr :: [Int] -> Bool-pFoldr = (L.sort . foldrSet (:) []) `eq`-         (L.sort . S.foldr (:) [])--foldrSet :: (a -> b -> b) -> b -> Set.Set a -> b-foldrSet = Set.foldr--pFoldl' :: Int -> [Int] -> Bool-pFoldl' z0 = foldl'Set (+) z0 `eq` S.foldl' (+) z0--foldl'Set :: (a -> b -> a) -> a -> Set.Set b -> a-foldl'Set = Set.foldl'----------------------------------------------------------------------------- ** Filter--pFilter :: [Key] -> Bool-pFilter = Set.filter odd `eq_` S.filter odd----------------------------------------------------------------------------- ** Conversions--pToList :: [Key] -> Bool-pToList = Set.toAscList `eq` toAscList----------------------------------------------------------------------------- * Test list--tests :: [Test]-tests =-    [-    -- Instances-      testGroup "instances"-      [ testProperty "==" pEq-      , testProperty "Permutation ==" pPermutationEq-      , testProperty "/=" pNeq-      , testProperty "compare reflexive" pOrd1-      , testProperty "compare transitive" pOrd2-      , testProperty "compare antisymmetric" pOrd3-      , testProperty "Ord => Eq" pOrdEq-      , testProperty "Read/Show" pReadShow-      , testProperty "Foldable" pFoldable-      , testProperty "Hashable" pHashable-      ]-    -- Basic interface-    , testGroup "basic interface"-      [ testProperty "size" pSize-      , testProperty "member" pMember-      , testProperty "insert" pInsert-      , testProperty "delete" pDelete-      ]-    -- Combine-    , testProperty "union" pUnion-    -- Transformations-    , testProperty "map" pMap-    -- Folds-    , testGroup "folds"-      [ testProperty "foldr" pFoldr-      , testProperty "foldl'" pFoldl'-      ]-    -- Filter-    , testGroup "filter"-      [ testProperty "filter" pFilter-      ]-    -- Conversions-    , testGroup "conversions"-      [ testProperty "toList" pToList-      ]-    ]----------------------------------------------------------------------------- * Model---- Invariant: the list is sorted in ascending order, by key.-type Model a = Set.Set a---- | Check that a function operating on a 'HashMap' is equivalent to--- one operating on a 'Model'.-eq :: (Eq a, Hashable a, Ord a, Eq b)-   => (Model a -> b)      -- ^ Function that modifies a 'Model' in the same-                          -- way-   -> (S.HashSet a -> b)  -- ^ Function that modified a 'HashSet'-   -> [a]                 -- ^ Initial content of the 'HashSet' and 'Model'-   -> Bool                -- ^ True if the functions are equivalent-eq f g xs = g (S.fromList xs) == f (Set.fromList xs)--eq_ :: (Eq a, Hashable a, Ord a)-    => (Model a -> Model a)          -- ^ Function that modifies a 'Model'-    -> (S.HashSet a -> S.HashSet a)  -- ^ Function that modified a-                                     -- 'HashSet' in the same way-    -> [a]                           -- ^ Initial content of the 'HashSet'-                                     -- and 'Model'-    -> Bool                          -- ^ True if the functions are-                                     -- equivalent-eq_ f g = (Set.toAscList . f) `eq` (toAscList . g)----------------------------------------------------------------------------- * Test harness--main :: IO ()-main = defaultMain tests----------------------------------------------------------------------------- * Helpers--toAscList :: Ord a => S.HashSet a -> [a]-toAscList = L.sort . S.toList

@@ -1,68 +0,0 @@-module Main (main) where--import Data.HashMap.Internal.List-import Data.List (nub, sort, sortBy)-import Data.Ord (comparing)--import Test.Framework (Test, defaultMain, testGroup)-import Test.Framework.Providers.QuickCheck2 (testProperty)-import Test.QuickCheck ((==>), (===), property, Property)--tests :: Test-tests = testGroup "Data.HashMap.Internal.List"-    [ testProperty "isPermutationBy" pIsPermutation-    , testProperty "isPermutationBy of different length" pIsPermutationDiffLength-    , testProperty "pUnorderedCompare" pUnorderedCompare-    , testGroup "modelUnorderedCompare"-        [ testProperty "reflexive" modelUnorderedCompareRefl-        , testProperty "anti-symmetric" modelUnorderedCompareAntiSymm-        , testProperty "transitive" modelUnorderedCompareTrans-        ]-    ]--pIsPermutation :: [Char] -> [Int] -> Bool-pIsPermutation xs is = isPermutationBy (==) xs xs'-  where-    is' = nub is ++ [maximum (0:is) + 1 ..]-    xs' = map fst . sortBy (comparing snd) $ zip xs is'--pIsPermutationDiffLength :: [Int] -> [Int] -> Property-pIsPermutationDiffLength xs ys =-    length xs /= length ys ==> isPermutationBy (==) xs ys === False---- | Homogenous version of 'unorderedCompare'------ *Compare smallest non-equal elements of the two lists*.-modelUnorderedCompare :: Ord a => [a] -> [a] -> Ordering-modelUnorderedCompare as bs = compare (sort as) (sort bs)--modelUnorderedCompareRefl :: [Int] -> Property-modelUnorderedCompareRefl xs = modelUnorderedCompare xs xs === EQ--modelUnorderedCompareAntiSymm :: [Int] -> [Int] -> Property-modelUnorderedCompareAntiSymm xs ys = case a of-    EQ -> b === EQ-    LT -> b === GT-    GT -> b === LT-  where-    a = modelUnorderedCompare xs ys-    b = modelUnorderedCompare ys xs--modelUnorderedCompareTrans :: [Int] -> [Int] -> [Int] -> Property-modelUnorderedCompareTrans xs ys zs =-    case (modelUnorderedCompare xs ys, modelUnorderedCompare ys zs) of-        (EQ, yz) -> xz === yz-        (xy, EQ) -> xz === xy-        (LT, LT) -> xz === LT-        (GT, GT) -> xz === GT-        (LT, GT) -> property True-        (GT, LT) -> property True-  where-    xz = modelUnorderedCompare xs zs--pUnorderedCompare :: [Int] -> [Int] -> Property-pUnorderedCompare xs ys =-    unorderedCompare compare xs ys === modelUnorderedCompare xs ys--main :: IO ()-main = defaultMain [tests]

@@ -0,0 +1,14 @@+module Main (main) where++import Test.Tasty (defaultMain, testGroup)++import qualified Properties+import qualified Regressions+import qualified Strictness++main :: IO ()+main = defaultMain $ testGroup "All"+  [ Properties.tests+  , Regressions.tests+  , Strictness.tests+  ]

@@ -0,0 +1,16 @@+module Properties (tests) where++import Test.Tasty (TestTree, testGroup)++import qualified Properties.HashMapLazy+import qualified Properties.HashMapStrict+import qualified Properties.HashSet+import qualified Properties.List++tests :: TestTree+tests = testGroup "Properties"+  [ Properties.HashMapLazy.tests+  , Properties.HashMapStrict.tests+  , Properties.HashSet.tests+  , Properties.List.tests+  ]

@@ -0,0 +1,591 @@+{-# LANGUAGE CPP                        #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} -- because of Arbitrary (HashMap k v)++-- | Tests for the 'Data.HashMap.Lazy' module.  We test functions by+-- comparing them to @Map@ from @containers@.++#if defined(STRICT)+#define MODULE_NAME Properties.HashMapStrict+#else+#define MODULE_NAME Properties.HashMapLazy+#endif++module MODULE_NAME (tests) where++import Control.Applicative      (Const (..))+import Control.Monad            (guard)+import Data.Bifoldable+import Data.Function            (on)+import Data.Functor.Identity    (Identity (..))+import Data.Hashable            (Hashable (hashWithSalt))+import Data.Ord                 (comparing)+import Test.QuickCheck          (Arbitrary (..), Property, elements, forAll,+                                 (===), (==>))+import Test.QuickCheck.Function (Fun, apply)+import Test.QuickCheck.Poly     (A, B)+import Test.Tasty               (TestTree, testGroup)+import Test.Tasty.QuickCheck    (testProperty)++import qualified Data.Foldable as Foldable+import qualified Data.List     as List++#if defined(STRICT)+import           Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as HM+import qualified Data.Map.Strict     as M+#else+import           Data.HashMap.Lazy (HashMap)+import qualified Data.HashMap.Lazy as HM+import qualified Data.Map.Lazy     as M+#endif++-- 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++instance (Eq k, Hashable k, Arbitrary k, Arbitrary v) => Arbitrary (HashMap k v) where+  arbitrary = fmap (HM.fromList) arbitrary++------------------------------------------------------------------------+-- * Properties++------------------------------------------------------------------------+-- ** Instances++pEq :: [(Key, Int)] -> [(Key, Int)] -> Bool+pEq xs = (M.fromList xs ==) `eq` (HM.fromList xs ==)++pNeq :: [(Key, Int)] -> [(Key, Int)] -> Bool+pNeq xs = (M.fromList xs /=) `eq` (HM.fromList xs /=)++-- We cannot compare to `Data.Map` as ordering is different.+pOrd1 :: [(Key, Int)] -> Bool+pOrd1 xs = compare x x == EQ+  where+    x = HM.fromList xs++pOrd2 :: [(Key, Int)] -> [(Key, Int)] -> [(Key, Int)] -> Bool+pOrd2 xs ys zs = case (compare x y, compare y z) of+    (EQ, o)  -> compare x z == o+    (o,  EQ) -> compare x z == o+    (LT, LT) -> compare x z == LT+    (GT, GT) -> compare x z == GT+    (LT, GT) -> True -- ys greater than xs and zs.+    (GT, LT) -> True+  where+    x = HM.fromList xs+    y = HM.fromList ys+    z = HM.fromList zs++pOrd3 :: [(Key, Int)] -> [(Key, Int)] -> Bool+pOrd3 xs ys = case (compare x y, compare y x) of+    (EQ, EQ) -> True+    (LT, GT) -> True+    (GT, LT) -> True+    _        -> False+  where+    x = HM.fromList xs+    y = HM.fromList ys++pOrdEq :: [(Key, Int)] -> [(Key, Int)] -> Bool+pOrdEq xs ys = case (compare x y, x == y) of+    (EQ, True)  -> True+    (LT, False) -> True+    (GT, False) -> True+    _           -> False+  where+    x = HM.fromList xs+    y = HM.fromList ys++pReadShow :: [(Key, Int)] -> Bool+pReadShow xs = M.fromList xs == read (show (M.fromList xs))++pFunctor :: [(Key, Int)] -> Bool+pFunctor = fmap (+ 1) `eq_` fmap (+ 1)++pFoldable :: [(Int, Int)] -> Bool+pFoldable = (List.sort . Foldable.foldr (:) []) `eq`+            (List.sort . Foldable.foldr (:) [])++pHashable :: [(Key, Int)] -> [Int] -> Int -> Property+pHashable xs is salt =+    x == y ==> hashWithSalt salt x === hashWithSalt salt y+  where+    xs' = List.nubBy (\(k,_) (k',_) -> k == k') xs+    ys = shuffle is xs'+    x = HM.fromList xs'+    y = HM.fromList ys+    -- Shuffle the list using indexes in the second+    shuffle :: [Int] -> [a] -> [a]+    shuffle idxs = List.map snd+                 . List.sortBy (comparing fst)+                 . List.zip (idxs ++ [List.maximum (0:is) + 1 ..])++------------------------------------------------------------------------+-- ** Basic interface++pSize :: [(Key, Int)] -> Bool+pSize = M.size `eq` HM.size++pMember :: Key -> [(Key, Int)] -> Bool+pMember k = M.member k `eq` HM.member k++pLookup :: Key -> [(Key, Int)] -> Bool+pLookup k = M.lookup k `eq` HM.lookup k++pLookupOperator :: Key -> [(Key, Int)] -> Bool+pLookupOperator k = M.lookup k `eq` (HM.!? k)++pInsert :: Key -> Int -> [(Key, Int)] -> Bool+pInsert k v = M.insert k v `eq_` HM.insert k v++pDelete :: Key -> [(Key, Int)] -> Bool+pDelete k = M.delete k `eq_` HM.delete k++newtype AlwaysCollide = AC Int+    deriving (Arbitrary, Eq, Ord, Show)++instance Hashable AlwaysCollide where+    hashWithSalt _ _ = 1++-- White-box test that tests the case of deleting one of two keys from+-- a map, where the keys' hash values collide.+pDeleteCollision :: AlwaysCollide -> AlwaysCollide -> AlwaysCollide -> Int+                 -> Property+pDeleteCollision k1 k2 k3 idx = (k1 /= k2) && (k2 /= k3) && (k1 /= k3) ==>+                                HM.member toKeep $ HM.delete toDelete $+                                HM.fromList [(k1, 1 :: Int), (k2, 2), (k3, 3)]+  where+    which = idx `mod` 3+    toDelete+        | which == 0 = k1+        | which == 1 = k2+        | which == 2 = k3+        | otherwise = error "Impossible"+    toKeep+        | which == 0 = k2+        | which == 1 = k3+        | which == 2 = k1+        | otherwise = error "Impossible"++pInsertWith :: Key -> [(Key, Int)] -> Bool+pInsertWith k = M.insertWith (+) k 1 `eq_` HM.insertWith (+) k 1++pAdjust :: Key -> [(Key, Int)] -> Bool+pAdjust k = M.adjust succ k `eq_` HM.adjust succ k++pUpdateAdjust :: Key -> [(Key, Int)] -> Bool+pUpdateAdjust k = M.update (Just . succ) k `eq_` HM.update (Just . succ) k++pUpdateDelete :: Key -> [(Key, Int)] -> Bool+pUpdateDelete k = M.update (const Nothing) k `eq_` HM.update (const Nothing) k++pAlterAdjust :: Key -> [(Key, Int)] -> Bool+pAlterAdjust k = M.alter (fmap succ) k `eq_` HM.alter (fmap succ) k++pAlterInsert :: Key -> [(Key, Int)] -> Bool+pAlterInsert k = M.alter (const $ Just 3) k `eq_` HM.alter (const $ Just 3) k++pAlterDelete :: Key -> [(Key, Int)] -> Bool+pAlterDelete k = M.alter (const Nothing) k `eq_` HM.alter (const Nothing) k+++-- We choose the list functor here because we don't fuss with+-- it in alterF rules and because it has a sufficiently interesting+-- structure to have a good chance of breaking if something is wrong.+pAlterF :: Key -> Fun (Maybe A) [Maybe A] -> [(Key, A)] -> Property+pAlterF k f xs =+  fmap M.toAscList (M.alterF (apply f) k (M.fromList xs))+  ===+  fmap toAscList (HM.alterF (apply f) k (HM.fromList xs))++pAlterFAdjust :: Key -> [(Key, Int)] -> Bool+pAlterFAdjust k =+  runIdentity . M.alterF (Identity . fmap succ) k `eq_`+  runIdentity . HM.alterF (Identity . fmap succ) k++pAlterFInsert :: Key -> [(Key, Int)] -> Bool+pAlterFInsert k =+  runIdentity . M.alterF (const . Identity . Just $ 3) k `eq_`+  runIdentity . HM.alterF (const . Identity . Just $ 3) k++pAlterFInsertWith :: Key -> Fun Int Int -> [(Key, Int)] -> Bool+pAlterFInsertWith k f =+  runIdentity . M.alterF (Identity . Just . maybe 3 (apply f)) k `eq_`+  runIdentity . HM.alterF (Identity . Just . maybe 3 (apply f)) k++pAlterFDelete :: Key -> [(Key, Int)] -> Bool+pAlterFDelete k =+  runIdentity . M.alterF (const (Identity Nothing)) k `eq_`+  runIdentity . HM.alterF (const (Identity Nothing)) k++pAlterFLookup :: Key+              -> Fun (Maybe A) B+              -> [(Key, A)] -> Bool+pAlterFLookup k f =+  getConst . M.alterF (Const . apply f :: Maybe A -> Const B (Maybe A)) k+  `eq`+  getConst . HM.alterF (Const . apply f) k++pSubmap :: [(Key, Int)] -> [(Key, Int)] -> Bool+pSubmap xs ys = M.isSubmapOf (M.fromList xs) (M.fromList ys) ==+                HM.isSubmapOf (HM.fromList xs) (HM.fromList ys)++pSubmapReflexive :: HashMap Key Int -> Bool+pSubmapReflexive m = HM.isSubmapOf m m++pSubmapUnion :: HashMap Key Int -> HashMap Key Int -> Bool+pSubmapUnion m1 m2 = HM.isSubmapOf m1 (HM.union m1 m2)++pNotSubmapUnion :: HashMap Key Int -> HashMap Key Int -> Property+pNotSubmapUnion m1 m2 = not (HM.isSubmapOf m1 m2) ==> HM.isSubmapOf m1 (HM.union m1 m2)++pSubmapDifference :: HashMap Key Int -> HashMap Key Int -> Bool+pSubmapDifference m1 m2 = HM.isSubmapOf (HM.difference m1 m2) m1++pNotSubmapDifference :: HashMap Key Int -> HashMap Key Int -> Property+pNotSubmapDifference m1 m2 =+  not (HM.null (HM.intersection m1 m2)) ==>+  not (HM.isSubmapOf m1 (HM.difference m1 m2))++pSubmapDelete :: HashMap Key Int -> Property+pSubmapDelete m = not (HM.null m) ==>+  forAll (elements (HM.keys m)) $ \k ->+  HM.isSubmapOf (HM.delete k m) m++pNotSubmapDelete :: HashMap Key Int -> Property+pNotSubmapDelete m =+  not (HM.null m) ==>+  forAll (elements (HM.keys m)) $ \k ->+  not (HM.isSubmapOf m (HM.delete k m))++pSubmapInsert :: Key -> Int -> HashMap Key Int -> Property+pSubmapInsert k v m = not (HM.member k m) ==> HM.isSubmapOf m (HM.insert k v m)++pNotSubmapInsert :: Key -> Int -> HashMap Key Int -> Property+pNotSubmapInsert k v m = not (HM.member k m) ==> not (HM.isSubmapOf (HM.insert k v m) m)++------------------------------------------------------------------------+-- ** Combine++pUnion :: [(Key, Int)] -> [(Key, Int)] -> Bool+pUnion xs ys = M.union (M.fromList xs) `eq_` HM.union (HM.fromList xs) $ ys++pUnionWith :: [(Key, Int)] -> [(Key, Int)] -> Bool+pUnionWith xs ys = M.unionWith (-) (M.fromList xs) `eq_`+                   HM.unionWith (-) (HM.fromList xs) $ ys++pUnionWithKey :: [(Key, Int)] -> [(Key, Int)] -> Bool+pUnionWithKey xs ys = M.unionWithKey go (M.fromList xs) `eq_`+                             HM.unionWithKey go (HM.fromList xs) $ ys+  where+    go :: Key -> Int -> Int -> Int+    go (K k) i1 i2 = k - i1 + i2++pUnions :: [[(Key, Int)]] -> Bool+pUnions xss = M.toAscList (M.unions (map M.fromList xss)) ==+              toAscList (HM.unions (map HM.fromList xss))++------------------------------------------------------------------------+-- ** Transformations++pMap :: [(Key, Int)] -> Bool+pMap = M.map (+ 1) `eq_` HM.map (+ 1)++pTraverse :: [(Key, Int)] -> Bool+pTraverse xs =+  List.sort (fmap (List.sort . M.toList) (M.traverseWithKey (\_ v -> [v + 1, v + 2]) (M.fromList (take 10 xs))))+     == List.sort (fmap (List.sort . HM.toList) (HM.traverseWithKey (\_ v -> [v + 1, v + 2]) (HM.fromList (take 10 xs))))++pMapKeys :: [(Int, Int)] -> Bool+pMapKeys = M.mapKeys (+1) `eq_` HM.mapKeys (+1)++------------------------------------------------------------------------+-- ** Difference and intersection++pDifference :: [(Key, Int)] -> [(Key, Int)] -> Bool+pDifference xs ys = M.difference (M.fromList xs) `eq_`+                    HM.difference (HM.fromList xs) $ ys++pDifferenceWith :: [(Key, Int)] -> [(Key, Int)] -> Bool+pDifferenceWith xs ys = M.differenceWith f (M.fromList xs) `eq_`+                        HM.differenceWith f (HM.fromList xs) $ ys+  where+    f x y = if x == 0 then Nothing else Just (x - y)++pIntersection :: [(Key, Int)] -> [(Key, Int)] -> Bool+pIntersection xs ys = M.intersection (M.fromList xs) `eq_`+                      HM.intersection (HM.fromList xs) $ ys++pIntersectionWith :: [(Key, Int)] -> [(Key, Int)] -> Bool+pIntersectionWith xs ys = M.intersectionWith (-) (M.fromList xs) `eq_`+                          HM.intersectionWith (-) (HM.fromList xs) $ ys++pIntersectionWithKey :: [(Key, Int)] -> [(Key, Int)] -> Bool+pIntersectionWithKey xs ys = M.intersectionWithKey go (M.fromList xs) `eq_`+                             HM.intersectionWithKey go (HM.fromList xs) $ ys+  where+    go :: Key -> Int -> Int -> Int+    go (K k) i1 i2 = k - i1 - i2++------------------------------------------------------------------------+-- ** Folds++pFoldr :: [(Int, Int)] -> Bool+pFoldr = (List.sort . M.foldr (:) []) `eq` (List.sort . HM.foldr (:) [])++pFoldl :: [(Int, Int)] -> Bool+pFoldl = (List.sort . M.foldl (flip (:)) []) `eq` (List.sort . HM.foldl (flip (:)) [])++pBifoldMap :: [(Int, Int)] -> Bool+pBifoldMap xs = concatMap f (HM.toList m) == bifoldMap (:[]) (:[]) m+  where f (k, v) = [k, v]+        m = HM.fromList xs++pBifoldr :: [(Int, Int)] -> Bool+pBifoldr xs = concatMap f (HM.toList m) == bifoldr (:) (:) [] m+  where f (k, v) = [k, v]+        m = HM.fromList xs++pBifoldl :: [(Int, Int)] -> Bool+pBifoldl xs = reverse (concatMap f $ HM.toList m) == bifoldl (flip (:)) (flip (:)) [] m+  where f (k, v) = [k, v]+        m = HM.fromList xs++pFoldrWithKey :: [(Int, Int)] -> Bool+pFoldrWithKey = (sortByKey . M.foldrWithKey f []) `eq`+                (sortByKey . HM.foldrWithKey f [])+  where f k v z = (k, v) : z++pFoldMapWithKey :: [(Int, Int)] -> Bool+pFoldMapWithKey = (sortByKey . M.foldMapWithKey f) `eq`+                  (sortByKey . HM.foldMapWithKey f)+  where f k v = [(k, v)]++pFoldrWithKey' :: [(Int, Int)] -> Bool+pFoldrWithKey' = (sortByKey . M.foldrWithKey' f []) `eq`+                 (sortByKey . HM.foldrWithKey' f [])+  where f k v z = (k, v) : z++pFoldlWithKey :: [(Int, Int)] -> Bool+pFoldlWithKey = (sortByKey . M.foldlWithKey f []) `eq`+                (sortByKey . HM.foldlWithKey f [])+  where f z k v = (k, v) : z++pFoldlWithKey' :: [(Int, Int)] -> Bool+pFoldlWithKey' = (sortByKey . M.foldlWithKey' f []) `eq`+                 (sortByKey . HM.foldlWithKey' f [])+  where f z k v = (k, v) : z++pFoldl' :: [(Int, Int)] -> Bool+pFoldl' = (List.sort . M.foldl' (flip (:)) []) `eq` (List.sort . HM.foldl' (flip (:)) [])++pFoldr' :: [(Int, Int)] -> Bool+pFoldr' = (List.sort . M.foldr' (:) []) `eq` (List.sort . HM.foldr' (:) [])++------------------------------------------------------------------------+-- ** Filter++pMapMaybeWithKey :: [(Key, Int)] -> Bool+pMapMaybeWithKey = M.mapMaybeWithKey f `eq_` HM.mapMaybeWithKey f+  where f k v = guard (odd (unK k + v)) >> Just (v + 1)++pMapMaybe :: [(Key, Int)] -> Bool+pMapMaybe = M.mapMaybe f `eq_` HM.mapMaybe f+  where f v = guard (odd v) >> Just (v + 1)++pFilter :: [(Key, Int)] -> Bool+pFilter = M.filter odd `eq_` HM.filter odd++pFilterWithKey :: [(Key, Int)] -> Bool+pFilterWithKey = M.filterWithKey p `eq_` HM.filterWithKey p+  where p k v = odd (unK k + v)++------------------------------------------------------------------------+-- ** Conversions++-- The free magma is used to test that operations are applied in the+-- same order.+data Magma a+  = Leaf a+  | Op (Magma a) (Magma a)+  deriving (Show, Eq, Ord)++instance Hashable a => Hashable (Magma a) where+  hashWithSalt s (Leaf a) = hashWithSalt s (hashWithSalt (1::Int) a)+  hashWithSalt s (Op m n) = hashWithSalt s (hashWithSalt (hashWithSalt (2::Int) m) n)++-- 'eq_' already calls fromList.+pFromList :: [(Key, Int)] -> Bool+pFromList = id `eq_` id++pFromListWith :: [(Key, Int)] -> Bool+pFromListWith kvs = (M.toAscList $ M.fromListWith Op kvsM) ==+                    (toAscList $ HM.fromListWith Op kvsM)+  where kvsM = fmap (fmap Leaf) kvs++pFromListWithKey :: [(Key, Int)] -> Bool+pFromListWithKey kvs = (M.toAscList $ M.fromListWithKey combine kvsM) ==+                       (toAscList $ HM.fromListWithKey combine kvsM)+  where kvsM = fmap (\(K k,v) -> (Leaf k, Leaf v)) kvs+        combine k v1 v2 = Op k (Op v1 v2)++pToList :: [(Key, Int)] -> Bool+pToList = M.toAscList `eq` toAscList++pElems :: [(Key, Int)] -> Bool+pElems = (List.sort . M.elems) `eq` (List.sort . HM.elems)++pKeys :: [(Key, Int)] -> Bool+pKeys = (List.sort . M.keys) `eq` (List.sort . HM.keys)++------------------------------------------------------------------------+-- * Test list++tests :: TestTree+tests =+  testGroup+#if defined(STRICT)+    "Data.HashMap.Strict"+#else+    "Data.HashMap.Lazy"+#endif+    [+    -- Instances+      testGroup "instances"+      [ testProperty "==" pEq+      , testProperty "/=" pNeq+      , testProperty "compare reflexive" pOrd1+      , testProperty "compare transitive" pOrd2+      , testProperty "compare antisymmetric" pOrd3+      , testProperty "Ord => Eq" pOrdEq+      , testProperty "Read/Show" pReadShow+      , testProperty "Functor" pFunctor+      , testProperty "Foldable" pFoldable+      , testProperty "Hashable" pHashable+      ]+    -- Basic interface+    , testGroup "basic interface"+      [ testProperty "size" pSize+      , testProperty "member" pMember+      , testProperty "lookup" pLookup+      , testProperty "!?" pLookupOperator+      , testProperty "insert" pInsert+      , testProperty "delete" pDelete+      , testProperty "deleteCollision" pDeleteCollision+      , testProperty "insertWith" pInsertWith+      , testProperty "adjust" pAdjust+      , testProperty "updateAdjust" pUpdateAdjust+      , testProperty "updateDelete" pUpdateDelete+      , testProperty "alterAdjust" pAlterAdjust+      , testProperty "alterInsert" pAlterInsert+      , testProperty "alterDelete" pAlterDelete+      , testProperty "alterF" pAlterF+      , testProperty "alterFAdjust" pAlterFAdjust+      , testProperty "alterFInsert" pAlterFInsert+      , testProperty "alterFInsertWith" pAlterFInsertWith+      , testProperty "alterFDelete" pAlterFDelete+      , testProperty "alterFLookup" pAlterFLookup+      , testGroup "isSubmapOf"+        [ testProperty "container compatibility" pSubmap+        , testProperty "m ⊆ m" pSubmapReflexive+        , testProperty "m1 ⊆ m1 ∪ m2" pSubmapUnion+        , testProperty "m1 ⊈ m2  ⇒  m1 ∪ m2 ⊈ m1" pNotSubmapUnion+        , testProperty "m1\\m2 ⊆ m1" pSubmapDifference+        , testProperty "m1 ∩ m2 ≠ ∅  ⇒  m1 ⊈ m1\\m2 " pNotSubmapDifference+        , testProperty "delete k m ⊆ m" pSubmapDelete+        , testProperty "m ⊈ delete k m " pNotSubmapDelete+        , testProperty "k ∉ m  ⇒  m ⊆ insert k v m" pSubmapInsert+        , testProperty "k ∉ m  ⇒  insert k v m ⊈ m" pNotSubmapInsert+        ]+      ]+    -- Combine+    , testProperty "union" pUnion+    , testProperty "unionWith" pUnionWith+    , testProperty "unionWithKey" pUnionWithKey+    , testProperty "unions" pUnions+    -- Transformations+    , testProperty "map" pMap+    , testProperty "traverse" pTraverse+    , testProperty "mapKeys" pMapKeys+    -- Folds+    , testGroup "folds"+      [ testProperty "foldr" pFoldr+      , testProperty "foldl" pFoldl+      , testProperty "bifoldMap" pBifoldMap+      , testProperty "bifoldr" pBifoldr+      , testProperty "bifoldl" pBifoldl+      , testProperty "foldrWithKey" pFoldrWithKey+      , testProperty "foldlWithKey" pFoldlWithKey+      , testProperty "foldrWithKey'" pFoldrWithKey'+      , testProperty "foldlWithKey'" pFoldlWithKey'+      , testProperty "foldl'" pFoldl'+      , testProperty "foldr'" pFoldr'+      , testProperty "foldMapWithKey" pFoldMapWithKey+      ]+    , testGroup "difference and intersection"+      [ testProperty "difference" pDifference+      , testProperty "differenceWith" pDifferenceWith+      , testProperty "intersection" pIntersection+      , testProperty "intersectionWith" pIntersectionWith+      , testProperty "intersectionWithKey" pIntersectionWithKey+      ]+    -- Filter+    , testGroup "filter"+      [ testProperty "filter" pFilter+      , testProperty "filterWithKey" pFilterWithKey+      , testProperty "mapMaybe" pMapMaybe+      , testProperty "mapMaybeWithKey" pMapMaybeWithKey+      ]+    -- Conversions+    , testGroup "conversions"+      [ testProperty "elems" pElems+      , testProperty "keys" pKeys+      , testProperty "fromList" pFromList+      , testProperty "fromListWith" pFromListWith+      , testProperty "fromListWithKey" pFromListWithKey+      , testProperty "toList" pToList+      ]+    ]++------------------------------------------------------------------------+-- * Model++type Model k v = M.Map k v++-- | Check that a function operating on a 'HashMap' is equivalent to+-- one operating on a 'Model'.+eq :: (Eq a, Eq k, Hashable k, Ord k)+   => (Model k v -> a)       -- ^ Function that modifies a 'Model'+   -> (HM.HashMap k v -> a)  -- ^ Function that modified a 'HashMap' in the same+                             -- way+   -> [(k, v)]               -- ^ Initial content of the 'HashMap' and 'Model'+   -> Bool                   -- ^ True if the functions are equivalent+eq f g xs = g (HM.fromList xs) == f (M.fromList xs)++infix 4 `eq`++eq_ :: (Eq k, Eq v, Hashable k, Ord k)+    => (Model k v -> Model k v)            -- ^ Function that modifies a 'Model'+    -> (HM.HashMap k v -> HM.HashMap k v)  -- ^ Function that modified a+                                           -- 'HashMap' in the same way+    -> [(k, v)]                            -- ^ Initial content of the 'HashMap'+                                           -- and 'Model'+    -> Bool                                -- ^ True if the functions are+                                           -- equivalent+eq_ f g = (M.toAscList . f) `eq` (toAscList . g)++infix 4 `eq_`++------------------------------------------------------------------------+-- * Helpers++sortByKey :: Ord k => [(k, v)] -> [(k, v)]+sortByKey = List.sortBy (compare `on` fst)++toAscList :: Ord k => HM.HashMap k v -> [(k, v)]+toAscList = List.sortBy (compare `on` fst) . HM.toList

@@ -0,0 +1,5 @@+{-# LANGUAGE CPP #-}++#define STRICT++#include "HashMapLazy.hs"

@@ -0,0 +1,236 @@+{-# LANGUAGE CPP                        #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++-- | Tests for the 'Data.HashSet' module.  We test functions by+-- comparing them to @Set@ from @containers@.++module Properties.HashSet (tests) where++import Data.Hashable         (Hashable (hashWithSalt))+import Data.Ord              (comparing)+import Test.QuickCheck       (Arbitrary, Property, (===), (==>))+import Test.Tasty            (TestTree, testGroup)+import Test.Tasty.QuickCheck (testProperty)++import qualified Data.Foldable as Foldable+import qualified Data.HashSet  as S+import qualified Data.List     as List+import qualified Data.Set      as Set++-- Key type that generates more hash collisions.+newtype Key = K { unK :: Int }+            deriving (Arbitrary, Enum, Eq, Integral, Num, Ord, Read, Show, Real)++instance Hashable Key where+    hashWithSalt salt k = hashWithSalt salt (unK k) `mod` 20++------------------------------------------------------------------------+-- * Properties++------------------------------------------------------------------------+-- ** Instances++pEq :: [Key] -> [Key] -> Bool+pEq xs = (Set.fromList xs ==) `eq` (S.fromList xs ==)++pNeq :: [Key] -> [Key] -> Bool+pNeq xs = (Set.fromList xs /=) `eq` (S.fromList xs /=)++-- We cannot compare to `Data.Map` as ordering is different.+pOrd1 :: [Key] -> Bool+pOrd1 xs = compare x x == EQ+  where+    x = S.fromList xs++pOrd2 :: [Key] -> [Key] -> [Key] -> Bool+pOrd2 xs ys zs = case (compare x y, compare y z) of+    (EQ, o)  -> compare x z == o+    (o,  EQ) -> compare x z == o+    (LT, LT) -> compare x z == LT+    (GT, GT) -> compare x z == GT+    (LT, GT) -> True -- ys greater than xs and zs.+    (GT, LT) -> True+  where+    x = S.fromList xs+    y = S.fromList ys+    z = S.fromList zs++pOrd3 :: [Key] -> [Key] -> Bool+pOrd3 xs ys = case (compare x y, compare y x) of+    (EQ, EQ) -> True+    (LT, GT) -> True+    (GT, LT) -> True+    _        -> False+  where+    x = S.fromList xs+    y = S.fromList ys++pOrdEq :: [Key] -> [Key] -> Bool+pOrdEq xs ys = case (compare x y, x == y) of+    (EQ, True)  -> True+    (LT, False) -> True+    (GT, False) -> True+    _           -> False+  where+    x = S.fromList xs+    y = S.fromList ys++pReadShow :: [Key] -> Bool+pReadShow xs = Set.fromList xs == read (show (Set.fromList xs))++pFoldable :: [Int] -> Bool+pFoldable = (List.sort . Foldable.foldr (:) []) `eq`+            (List.sort . Foldable.foldr (:) [])++pPermutationEq :: [Key] -> [Int] -> Bool+pPermutationEq xs is = S.fromList xs == S.fromList ys+  where+    ys = shuffle is xs+    shuffle idxs = List.map snd+                 . List.sortBy (comparing fst)+                 . List.zip (idxs ++ [List.maximum (0:is) + 1 ..])++pHashable :: [Key] -> [Int] -> Int -> Property+pHashable xs is salt =+    x == y ==> hashWithSalt salt x === hashWithSalt salt y+  where+    xs' = List.nub xs+    ys = shuffle is xs'+    x = S.fromList xs'+    y = S.fromList ys+    shuffle idxs = List.map snd+                 . List.sortBy (comparing fst)+                 . List.zip (idxs ++ [List.maximum (0:is) + 1 ..])++------------------------------------------------------------------------+-- ** Basic interface++pSize :: [Key] -> Bool+pSize = Set.size `eq` S.size++pMember :: Key -> [Key] -> Bool+pMember k = Set.member k `eq` S.member k++pInsert :: Key -> [Key] -> Bool+pInsert a = Set.insert a `eq_` S.insert a++pDelete :: Key -> [Key] -> Bool+pDelete a = Set.delete a `eq_` S.delete a++------------------------------------------------------------------------+-- ** Combine++pUnion :: [Key] -> [Key] -> Bool+pUnion xs ys = Set.union (Set.fromList xs) `eq_`+               S.union (S.fromList xs) $ ys++------------------------------------------------------------------------+-- ** Transformations++pMap :: [Key] -> Bool+pMap = Set.map (+ 1) `eq_` S.map (+ 1)++------------------------------------------------------------------------+-- ** Folds++pFoldr :: [Int] -> Bool+pFoldr = (List.sort . foldrSet (:) []) `eq`+         (List.sort . S.foldr (:) [])++foldrSet :: (a -> b -> b) -> b -> Set.Set a -> b+foldrSet = Set.foldr++pFoldl' :: Int -> [Int] -> Bool+pFoldl' z0 = foldl'Set (+) z0 `eq` S.foldl' (+) z0++foldl'Set :: (a -> b -> a) -> a -> Set.Set b -> a+foldl'Set = Set.foldl'++------------------------------------------------------------------------+-- ** Filter++pFilter :: [Key] -> Bool+pFilter = Set.filter odd `eq_` S.filter odd++------------------------------------------------------------------------+-- ** Conversions++pToList :: [Key] -> Bool+pToList = Set.toAscList `eq` toAscList++------------------------------------------------------------------------+-- * Test list++tests :: TestTree+tests = testGroup "Data.HashSet"+    [+    -- Instances+      testGroup "instances"+      [ testProperty "==" pEq+      , testProperty "Permutation ==" pPermutationEq+      , testProperty "/=" pNeq+      , testProperty "compare reflexive" pOrd1+      , testProperty "compare transitive" pOrd2+      , testProperty "compare antisymmetric" pOrd3+      , testProperty "Ord => Eq" pOrdEq+      , testProperty "Read/Show" pReadShow+      , testProperty "Foldable" pFoldable+      , testProperty "Hashable" pHashable+      ]+    -- Basic interface+    , testGroup "basic interface"+      [ testProperty "size" pSize+      , testProperty "member" pMember+      , testProperty "insert" pInsert+      , testProperty "delete" pDelete+      ]+    -- Combine+    , testProperty "union" pUnion+    -- Transformations+    , testProperty "map" pMap+    -- Folds+    , testGroup "folds"+      [ testProperty "foldr" pFoldr+      , testProperty "foldl'" pFoldl'+      ]+    -- Filter+    , testGroup "filter"+      [ testProperty "filter" pFilter+      ]+    -- Conversions+    , testGroup "conversions"+      [ testProperty "toList" pToList+      ]+    ]++------------------------------------------------------------------------+-- * Model++-- Invariant: the list is sorted in ascending order, by key.+type Model a = Set.Set a++-- | Check that a function operating on a 'HashMap' is equivalent to+-- one operating on a 'Model'.+eq :: (Eq a, Hashable a, Ord a, Eq b)+   => (Model a -> b)      -- ^ Function that modifies a 'Model' in the same+                          -- way+   -> (S.HashSet a -> b)  -- ^ Function that modified a 'HashSet'+   -> [a]                 -- ^ Initial content of the 'HashSet' and 'Model'+   -> Bool                -- ^ True if the functions are equivalent+eq f g xs = g (S.fromList xs) == f (Set.fromList xs)++eq_ :: (Eq a, Hashable a, Ord a)+    => (Model a -> Model a)          -- ^ Function that modifies a 'Model'+    -> (S.HashSet a -> S.HashSet a)  -- ^ Function that modified a+                                     -- 'HashSet' in the same way+    -> [a]                           -- ^ Initial content of the 'HashSet'+                                     -- and 'Model'+    -> Bool                          -- ^ True if the functions are+                                     -- equivalent+eq_ f g = (Set.toAscList . f) `eq` (toAscList . g)++------------------------------------------------------------------------+-- * Helpers++toAscList :: Ord a => S.HashSet a -> [a]+toAscList = List.sort . S.toList

@@ -0,0 +1,64 @@+module Properties.List (tests) where++import Data.HashMap.Internal.List+import Data.List                  (nub, sort, sortBy)+import Data.Ord                   (comparing)+import Test.QuickCheck            (Property, property, (===), (==>))+import Test.Tasty                 (TestTree, testGroup)+import Test.Tasty.QuickCheck      (testProperty)++tests :: TestTree+tests = testGroup "Data.HashMap.Internal.List"+    [ testProperty "isPermutationBy" pIsPermutation+    , testProperty "isPermutationBy of different length" pIsPermutationDiffLength+    , testProperty "pUnorderedCompare" pUnorderedCompare+    , testGroup "modelUnorderedCompare"+        [ testProperty "reflexive" modelUnorderedCompareRefl+        , testProperty "anti-symmetric" modelUnorderedCompareAntiSymm+        , testProperty "transitive" modelUnorderedCompareTrans+        ]+    ]++pIsPermutation :: [Char] -> [Int] -> Bool+pIsPermutation xs is = isPermutationBy (==) xs xs'+  where+    is' = nub is ++ [maximum (0:is) + 1 ..]+    xs' = map fst . sortBy (comparing snd) $ zip xs is'++pIsPermutationDiffLength :: [Int] -> [Int] -> Property+pIsPermutationDiffLength xs ys =+    length xs /= length ys ==> isPermutationBy (==) xs ys === False++-- | Homogenous version of 'unorderedCompare'+--+-- *Compare smallest non-equal elements of the two lists*.+modelUnorderedCompare :: Ord a => [a] -> [a] -> Ordering+modelUnorderedCompare as bs = compare (sort as) (sort bs)++modelUnorderedCompareRefl :: [Int] -> Property+modelUnorderedCompareRefl xs = modelUnorderedCompare xs xs === EQ++modelUnorderedCompareAntiSymm :: [Int] -> [Int] -> Property+modelUnorderedCompareAntiSymm xs ys = case a of+    EQ -> b === EQ+    LT -> b === GT+    GT -> b === LT+  where+    a = modelUnorderedCompare xs ys+    b = modelUnorderedCompare ys xs++modelUnorderedCompareTrans :: [Int] -> [Int] -> [Int] -> Property+modelUnorderedCompareTrans xs ys zs =+    case (modelUnorderedCompare xs ys, modelUnorderedCompare ys zs) of+        (EQ, yz) -> xz === yz+        (xy, EQ) -> xz === xy+        (LT, LT) -> xz === LT+        (GT, GT) -> xz === GT+        (LT, GT) -> property True+        (GT, LT) -> property True+  where+    xz = modelUnorderedCompare xs zs++pUnorderedCompare :: [Int] -> [Int] -> Property+pUnorderedCompare xs ys =+    unorderedCompare compare xs ys === modelUnorderedCompare xs ys

@@ -1,32 +1,33 @@+{-# LANGUAGE MagicHash           #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE UnboxedTuples #-}-module Main where+{-# LANGUAGE UnboxedTuples       #-}+module Regressions (tests) where -import Control.Exception (evaluate)-import Control.Monad (replicateM)-import Data.Hashable (Hashable(..))-import qualified Data.HashMap.Strict as HM-import qualified Data.HashMap.Lazy as HML-import Data.List (delete)-import Data.Maybe-import GHC.Exts (touch#)-import GHC.IO (IO (..))-import System.Mem (performGC)-import System.Mem.Weak (mkWeakPtr, deRefWeak)-import System.Random (randomIO)-import Test.HUnit (Assertion, assert)-import Test.Framework (Test, defaultMain)-import Test.Framework.Providers.HUnit (testCase)-import Test.Framework.Providers.QuickCheck2 (testProperty)+import Control.Exception     (evaluate)+import Control.Monad         (replicateM)+import Data.Hashable         (Hashable (..))+import Data.List             (delete)+import Data.Maybe            (isJust, isNothing)+import GHC.Exts              (touch#)+import GHC.IO                (IO (..))+import System.Mem            (performGC)+import System.Mem.Weak       (deRefWeak, mkWeakPtr)+import System.Random         (randomIO)+import Test.HUnit            (Assertion, assert) import Test.QuickCheck+import Test.Tasty            (TestTree, testGroup)+import Test.Tasty.HUnit      (testCase)+import Test.Tasty.QuickCheck (testProperty) +import qualified Data.HashMap.Lazy   as HML+import qualified Data.HashMap.Strict as HMS+ issue32 :: Assertion-issue32 = assert $ isJust $ HM.lookup 7 m'+issue32 = assert $ isJust $ HMS.lookup 7 m'   where     ns = [0..16] :: [Int]-    m = HM.fromList (zip ns (repeat []))-    m' = HM.delete 10 m+    m = HMS.fromList (zip ns (repeat []))+    m' = HMS.delete 10 m  ------------------------------------------------------------------------ -- Issue #39@@ -36,8 +37,8 @@ issue39 :: Assertion issue39 = assert $ hm1 == hm2   where-    hm1 = HM.fromList ([a, b] `zip` [1, 1 :: Int ..])-    hm2 = HM.fromList ([b, a] `zip` [1, 1 :: Int ..])+    hm1 = HMS.fromList ([a, b] `zip` [1, 1 :: Int ..])+    hm2 = HMS.fromList ([b, a] `zip` [1, 1 :: Int ..])     a = (1, -1) :: (Int, Int)     b = (-1, 1) :: (Int, Int) @@ -76,10 +77,10 @@ propEqAfterDelete (Keys keys) =   let keyMap = mapFromKeys keys       k      = head keys-  in  HM.delete k keyMap == mapFromKeys (delete k keys)+  in  HMS.delete k keyMap == mapFromKeys (delete k keys) -mapFromKeys :: [Int] -> HM.HashMap Int ()-mapFromKeys keys = HM.fromList (zip keys (repeat ()))+mapFromKeys :: [Int] -> HMS.HashMap Int ()+mapFromKeys keys = HMS.fromList (zip keys (repeat ()))  ------------------------------------------------------------------------ -- Issue #254@@ -117,7 +118,7 @@   i :: Int <- randomIO   let oldV = show i   weakV <- mkWeakPtr oldV Nothing-  mp <- evaluate $ HM.insert (KC 1) "3" $ HM.fromList [(KC 0, "1"), (KC 1, oldV)]+  mp <- evaluate $ HMS.insert (KC 1) "3" $ HMS.fromList [(KC 0, "1"), (KC 1, oldV)]   performGC   res <- deRefWeak weakV   touch mp@@ -126,8 +127,8 @@ ------------------------------------------------------------------------ -- * Test list -tests :: [Test]-tests =+tests :: TestTree+tests = testGroup "Regression tests"     [       testCase "issue32" issue32     , testCase "issue39a" issue39@@ -135,9 +136,3 @@     , testCase "issue254 lazy" issue254Lazy     , testCase "issue254 strict" issue254Strict     ]----------------------------------------------------------------------------- * Test harness--main :: IO ()-main = defaultMain tests

@@ -1,21 +1,24 @@-{-# LANGUAGE CPP, FlexibleInstances, GeneralizedNewtypeDeriving #-}+{-# LANGUAGE CPP                        #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -module Main (main) where+module Strictness (tests) where -import Data.Hashable (Hashable(hashWithSalt))+import Control.Arrow                (second)+import Control.Monad                (guard)+import Data.Foldable                (foldl')+import Data.HashMap.Strict          (HashMap)+import Data.Hashable                (Hashable (hashWithSalt))+import Data.Maybe                   (fromMaybe, isJust) import Test.ChasingBottoms.IsBottom-import Test.Framework (Test, defaultMain, testGroup)-import Test.Framework.Providers.QuickCheck2 (testProperty)-import Test.QuickCheck (Arbitrary(arbitrary), Property, (===), (.&&.))+import Test.QuickCheck              (Arbitrary (arbitrary), Property, (.&&.),+                                     (===)) import Test.QuickCheck.Function-import Test.QuickCheck.Poly (A)-import Data.Maybe (fromMaybe, isJust)-import Control.Arrow (second)-import Control.Monad (guard)-import Data.Foldable (foldl')+import Test.QuickCheck.Poly         (A)+import Test.Tasty                   (TestTree, testGroup)+import Test.Tasty.QuickCheck        (testProperty) -import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HM  -- Key type that generates more hash collisions.@@ -149,8 +152,8 @@ ------------------------------------------------------------------------ -- * Test list -tests :: [Test]-tests =+tests :: TestTree+tests = testGroup "Strictness"     [     -- Basic interface       testGroup "HashMap.Strict"@@ -174,12 +177,6 @@       , testProperty "fromListWith is value-strict" pFromListWithValueResultStrict       ]     ]----------------------------------------------------------------------------- * Test harness--main :: IO ()-main = defaultMain tests  ------------------------------------------------------------------------ -- * Utilities

@@ -1,5 +1,5 @@ name:           unordered-containers-version:        0.2.16.0+version:        0.2.17.0 synopsis:       Efficient hashing-based container types description:   Efficient hashing-based container types.  The containers have been@@ -18,7 +18,7 @@ license:        BSD3 license-file:   LICENSE author:         Johan Tibell-maintainer:     johan.tibell@gmail.com, David.Feuer@gmail.com+maintainer:     simon.jakobi@gmail.com, David.Feuer@gmail.com Homepage:       https://github.com/haskell-unordered-containers/unordered-containers bug-reports:    https://github.com/haskell-unordered-containers/unordered-containers/issues copyright:      2010-2014 Johan Tibell@@ -30,13 +30,12 @@  tested-with:   GHC ==9.2.1-   || ==9.0.1+   || ==9.0.2    || ==8.10.7    || ==8.8.4    || ==8.6.5    || ==8.4.4    || ==8.2.2-   || ==8.0.2  flag debug   description:  Enable debug support@@ -54,9 +53,10 @@     Data.HashSet.Internal    build-depends:-    base >= 4.9 && < 5,-    deepseq >= 1.1,-    hashable >= 1.0.1.1 && < 1.5+    base >= 4.10 && < 5,+    deepseq >= 1.4.3,+    hashable >= 1.2.5 && < 1.5,+    template-haskell < 2.19    default-language: Haskell2010 @@ -69,119 +69,33 @@    ghc-options: -Wall -O2 -fwarn-tabs -ferror-spans -  if impl (ghc < 8.2)-    -- This is absolutely necessary (but not sufficient) for correctness due to-    -- the referential-transparency-breaking mutability in unsafeInsertWith. See-    -- #147 and GHC #13615 for details. The bug was fixed in GHC 8.2.-    ghc-options: -feager-blackholing   if flag(debug)     cpp-options: -DASSERTS -test-suite hashmap-lazy-properties-  hs-source-dirs: tests-  main-is: HashMapProperties.hs-  type: exitcode-stdio-1.0--  build-depends:-    base,-    containers >= 0.5.8,-    hashable >= 1.0.1.1,-    QuickCheck >= 2.4.0.1,-    test-framework >= 0.3.3,-    test-framework-quickcheck2 >= 0.2.9,-    unordered-containers--  default-language: Haskell2010-  ghc-options: -Wall-  cpp-options: -DASSERTS--test-suite hashmap-strict-properties-  hs-source-dirs: tests-  main-is: HashMapProperties.hs-  type: exitcode-stdio-1.0--  build-depends:-    base,-    containers >= 0.5.8,-    hashable >= 1.0.1.1,-    QuickCheck >= 2.4.0.1,-    test-framework >= 0.3.3,-    test-framework-quickcheck2 >= 0.2.9,-    unordered-containers--  default-language: Haskell2010-  ghc-options: -Wall-  cpp-options: -DASSERTS -DSTRICT--test-suite hashset-properties+test-suite unordered-containers-tests   hs-source-dirs: tests-  main-is: HashSetProperties.hs+  main-is: Main.hs   type: exitcode-stdio-1.0--  build-depends:-    base,-    containers >= 0.4.2.0,-    hashable >= 1.0.1.1,-    QuickCheck >= 2.4.0.1,-    test-framework >= 0.3.3,-    test-framework-quickcheck2 >= 0.2.9,-    unordered-containers--  default-language: Haskell2010-  ghc-options: -Wall-  cpp-options: -DASSERTS--test-suite list-tests-  hs-source-dirs: tests .-  main-is: List.hs   other-modules:-    Data.HashMap.Internal.List-  type: exitcode-stdio-1.0--  build-depends:-    base,-    containers >= 0.4,-    QuickCheck >= 2.4.0.1,-    test-framework >= 0.3.3,-    test-framework-quickcheck2 >= 0.2.9--  default-language: Haskell2010-  ghc-options: -Wall-  cpp-options: -DASSERTS--test-suite regressions-  hs-source-dirs: tests-  main-is: Regressions.hs-  type: exitcode-stdio-1.0+    Regressions+    Properties+    Properties.HashMapLazy+    Properties.HashMapStrict+    Properties.HashSet+    Properties.List+    Strictness    build-depends:     base,-    hashable >= 1.0.1.1,+    ChasingBottoms,+    containers >= 0.5.8,+    hashable,     HUnit,     QuickCheck >= 2.4.0.1,     random,-    test-framework >= 0.3.3,-    test-framework-hunit,-    test-framework-quickcheck2,-    unordered-containers--  default-language: Haskell2010-  ghc-options: -Wall-  cpp-options: -DASSERTS--test-suite strictness-properties-  hs-source-dirs: tests-  main-is: Strictness.hs-  type: exitcode-stdio-1.0--  build-depends:-    base,-    ChasingBottoms,-    containers >= 0.4.2,-    hashable >= 1.0.1.1,-    QuickCheck >= 2.4.0.1,-    test-framework >= 0.3.3,-    test-framework-quickcheck2 >= 0.2.9,+    tasty >= 1.4.0.3,+    tasty-hunit >= 0.10.0.3,+    tasty-quickcheck >= 0.10.1.2,     unordered-containers    default-language: Haskell2010@@ -202,16 +116,19 @@     base >= 4.8.0,     bytestring >= 0.10.0.0,     containers,-    gauge >= 0.2.5 && < 0.3,-    deepseq >= 1.4,-    hashable >= 1.0.1.1,+    deepseq,+    hashable,     hashmap,     mtl,     random,+    tasty-bench >= 0.3.1,     unordered-containers    default-language: Haskell2010-  ghc-options: -Wall -O2 -rtsopts -fwarn-tabs -ferror-spans+  ghc-options: -Wall -O2 -rtsopts -with-rtsopts=-A32m+  if impl(ghc >= 8.10)+    ghc-options: "-with-rtsopts=-A32m --nonmoving-gc"+  -- cpp-options: -DBENCH_containers_Map -DBENCH_containers_IntMap -DBENCH_hashmap_Map  source-repository head   type:     git