QuickCheck properties for IntSet

David Benbennick dbenbenn at gmail.com
Sun Dec 2 23:56:38 EST 2007


Here's a patch to IntSet.hs that adds many QuickCheck properties.  It
adds properties testing almost all of the public interface of IntSet,
and also properties testing that the data type invariants are never
broken.  (The patch doesn't test the Data, Eq, Monoid, Read, or
Typeable instances.)

Also, this patch removes a helper function, foldlStrict, and replaces
it with calls to Data.List.foldl'.

I have two questions:

1) Is this the right way to submit patches?
2) Is there a good reason that IntSet doesn't use "deriving Eq", and
instead manually implements the Eq instance?
-------------- next part --------------

New patches:

[IntSet QuickCheck properties
David Benbennick <dbenbenn at gmail.com>**20071203040728
 
 1) Remove foldlStrict, and use Data.List.foldl' instead.
 2) Add many QuickCheck properties, checking almost
    every exported function of IntSet.
] {
hunk ./Data/IntSet.hs 114
-import List (nub,sort)
-import qualified List
hunk ./Data/IntSet.hs 115
+import qualified Prelude
hunk ./Data/IntSet.hs 315
-  = foldlStrict union empty xs
+  = List.foldl' union empty xs
hunk ./Data/IntSet.hs 410
+-- Return LT if t1 is a proper subset of t2,
+-- EQ if t1 == t2, and GT otherwise.
hunk ./Data/IntSet.hs 677
-  = foldlStrict ins empty xs
+  = List.foldl' ins empty xs
hunk ./Data/IntSet.hs 942
-{--------------------------------------------------------------------
-  Utilities 
---------------------------------------------------------------------}
-foldlStrict f z xs
-  = case xs of
-      []     -> z
-      (x:xx) -> let z' = f z x in seq z' (foldlStrict f z' xx)
-
-
hunk ./Data/IntSet.hs 943
-{--------------------------------------------------------------------
-  Testing
---------------------------------------------------------------------}
-testTree :: [Int] -> IntSet
-testTree xs   = fromList xs
-test1 = testTree [1..20]
-test2 = testTree [30,29..10]
-test3 = testTree [1,4,6,89,2323,53,43,234,5,79,12,9,24,9,8,423,8,42,4,8,9,3]
-
hunk ./Data/IntSet.hs 961
-  arbitrary = do{ xs <- arbitrary
-                ; return (fromList xs)
-                }
+  arbitrary = arbitrary >>= return . fromList
+  coarbitrary Nil = variant 0
+  coarbitrary (Tip x) = variant 1 . coarbitrary x
+  coarbitrary (Bin _ _ left right) = variant 2 . coarbitrary left . coarbitrary right
hunk ./Data/IntSet.hs 997
-    == List.sort ((List.\\) (nub xs)  (nub ys))
+    == List.sort ((List.\\) (List.nub xs)  (List.nub ys))
hunk ./Data/IntSet.hs 1002
-    == List.sort (nub ((List.intersect) (xs)  (ys)))
+    == List.sort (List.nub ((List.intersect) (xs)  (ys)))
hunk ./Data/IntSet.hs 1014
-  = (sort (nub xs) == toAscList (fromList xs))
+  = (List.sort (List.nub xs) == toAscList (fromList xs))
hunk ./Data/IntSet.hs 1017
-  Bin invariants
+  Check that after every operation, an IntSet satisfies its invariants
hunk ./Data/IntSet.hs 1019
-powersOf2 :: IntSet
-powersOf2 = fromList [2^i | i <- [0..63]]
+isValid Nil = True
+isValid s = isValid' s where
+  isValid' (Tip _) = True
+  isValid' Nil = False
+  isValid' s@(Bin prefix msk left right) = checkPrefix s && isPow2 msk && checkLeftRight s && isValid' left && isValid' right
hunk ./Data/IntSet.hs 1025
--- Check the invariant that the mask is a power of 2.
-prop_MaskPow2 :: IntSet -> Bool
-prop_MaskPow2 (Bin _ msk left right) = member msk powersOf2 && prop_MaskPow2 left && prop_MaskPow2 right
-prop_MaskPow2 _ = True
+  -- Check that the prefix satisfies its invariant.
+  checkPrefix s@(Bin prefix msk _ _) = all (\elem -> match elem prefix msk) $ toList s
hunk ./Data/IntSet.hs 1028
--- Check that the prefix satisfies its invariant.
-prop_Prefix :: IntSet -> Bool
-prop_Prefix s@(Bin prefix msk left right) = all (\elem -> match elem prefix msk) (toList s) && prop_Prefix left && prop_Prefix right
-prop_Prefix _ = True
+  isPow2 x = x .&. (x - 1) == 0
hunk ./Data/IntSet.hs 1030
--- Check that the left elements don't have the mask bit set, and the right
--- ones do.
-prop_LeftRight :: IntSet -> Bool
-prop_LeftRight (Bin _ msk left right) = and [x .&. msk == 0 | x <- toList left] && and [x .&. msk == msk | x <- toList right]
-prop_LeftRight _ = True
+  -- Check that the left elements don't have the mask bit set, and the right
+  -- ones do.
+  checkLeftRight (Bin _ msk left right) = and [x .&. msk == 0 | x <- toList left] && and [x .&. msk == msk | x <- toList right]
+
+prop_valid_bkbk a b = isValid $ a \\ b
+prop_valid_empty = isValid empty
+prop_valid_singleton a = isValid $ singleton a
+prop_valid_insert a b = isValid $ insert a b
+prop_valid_delete a b = isValid $ delete a b
+prop_valid_union a b = isValid $ union a b
+prop_valid_unions a = isValid $ unions a
+prop_valid_difference a b = isValid $ difference a b
+prop_valid_intersection a b = isValid $ intersection a b
+prop_valid_filter a b = isValid $ filter a b
+prop_valid_partition a b = all isValid [x, y] where
+  (x, y) = partition a b
+prop_valid_split a b = all isValid [x, y] where
+  (x, y) = split a b
+prop_valid_splitMember a b = all isValid [x, y] where
+  (x, _, y) = splitMember a b
+prop_valid_deleteMin a = not (null a) ==> isValid (deleteMin a)
+prop_valid_deleteMax a = not (null a) ==> isValid (deleteMax a)
+prop_valid_deleteFindMin a = not (null a) ==> isValid (snd $ deleteFindMin a)
+prop_valid_deleteFindMax a = not (null a) ==> isValid (snd $ deleteFindMax a)
+prop_valid_maxView a = all (isValid . snd) $ maxView a
+prop_valid_minView a = all (isValid . snd) $ minView a
+prop_valid_map a b = isValid $ map a b
+prop_valid_fromList a = isValid $ fromList a
+prop_valid_fromAscList a = isValid $ fromAscList b where
+  b = List.sort a
+prop_valid_fromDistinctAscList a = isValid $ fromDistinctAscList b where
+  b = toList a
hunk ./Data/IntSet.hs 1064
-  IntSet operations are like Set operations
+  IntSet functions are like Set functions
hunk ./Data/IntSet.hs 1066
+-- Helper
hunk ./Data/IntSet.hs 1070
--- Check that IntSet.isProperSubsetOf is the same as Set.isProperSubsetOf.
+-- Check the helper is right
+prop_toSet :: IntSet -> Bool
+prop_toSet a = a == fromList (Set.toList $ toSet a)
+
+prop_bkbk :: IntSet -> IntSet -> Bool
+prop_bkbk a b = toSet (a \\ b) == (toSet a) Set.\\ (toSet b)
+
+prop_null :: IntSet -> Bool
+prop_null a = null a == Set.null (toSet a)
+
+prop_size :: IntSet -> Bool
+prop_size a = size a == Set.size (toSet a)
+
+prop_member :: Int -> IntSet -> Bool
+prop_member a b = member a b == Set.member a (toSet b)
+
+prop_notMember :: Int -> IntSet -> Bool
+prop_notMember a b = notMember a b == Set.notMember a (toSet b)
+
+-- For testing isSubsetOf and isProperSubsetOf:
+-- Given two random sets a and b, it is very unlikely that a is a subset of b.
+-- So prop_isSubsetOf only checks the "False" case.
+-- prop_isSubsetOf2 manufactures the "True" case.
+prop_isSubsetOf :: IntSet -> IntSet -> Bool
+prop_isSubsetOf a b = isSubsetOf a b == Set.isSubsetOf (toSet a) (toSet b)
+
+prop_isSubsetOf2 :: IntSet -> IntSet -> Bool
+prop_isSubsetOf2 a b = isSubsetOf a c == Set.isSubsetOf (toSet a) (toSet c) where
+  c = union a b
+
hunk ./Data/IntSet.hs 1103
--- In the above test, isProperSubsetOf almost always returns False (since a
--- random set is almost never a subset of another random set).  So this second
--- test checks the True case.
hunk ./Data/IntSet.hs 1106
+
+prop_empty :: Bool
+prop_empty = toSet empty == Set.empty
+
+prop_singleton :: Int -> Bool
+prop_singleton a = toSet (singleton a) == Set.singleton a
+
+prop_insert :: Int -> IntSet -> Bool
+prop_insert a b = toSet (insert a b) == Set.insert a (toSet b)
+
+prop_delete :: Int -> IntSet -> Bool
+prop_delete a b = toSet (delete a b) == Set.delete a (toSet b)
+
+prop_union :: IntSet -> IntSet -> Bool
+prop_union a b = toSet (union a b) == Set.union (toSet a) (toSet b)
+
+prop_unions :: [IntSet] -> Bool
+prop_unions a = toSet (unions a) == Set.unions (Prelude.map toSet a)
+
+prop_difference :: IntSet -> IntSet -> Bool
+prop_difference a b = toSet (difference a b) == Set.difference (toSet a) (toSet b)
+
+prop_intersection :: IntSet -> IntSet -> Bool
+prop_intersection a b = toSet (intersection a b) == Set.intersection (toSet a) (toSet b)
+
+instance Show (Int -> Bool) where
+  show _ = "<function :: Int -> Bool>"
+instance Show (Int -> Int) where
+  show _ = "<function :: Int -> Int>"
+instance Show (Int -> Int -> Int) where
+  show _ = "<function :: Int -> Int -> Int>"
+instance Arbitrary Char where
+  arbitrary = choose ('\0', '\255')
+
+prop_filter :: (Int -> Bool) -> IntSet -> Bool
+prop_filter a b = toSet c == Set.filter a (toSet b) where
+  c = filter a b
+
+prop_partition :: (Int -> Bool) -> IntSet -> Bool
+prop_partition a b = (toSet c, toSet d) == Set.partition a (toSet b) where
+  (c, d) = partition a b
+
+prop_split :: Int -> IntSet -> Bool
+prop_split a b = (toSet x, toSet z) == Set.split a (toSet b) where
+  (x, z) = split a b
+
+prop_splitMember :: Int -> IntSet -> Bool
+prop_splitMember a b = (toSet x, y, toSet z) == Set.splitMember a (toSet b) where
+  (x, y, z) = splitMember a b
+
+prop_findMin :: IntSet -> Property
+prop_findMin a = not (null a) ==> findMin a == Set.findMin (toSet a)
+
+prop_findMax :: IntSet -> Property
+prop_findMax a = not (null a) ==> findMax a == Set.findMax (toSet a)
+
+prop_deleteMin :: IntSet -> Property
+prop_deleteMin a = not (null a) ==> toSet (deleteMin a) == Set.deleteMin (toSet a)
+
+prop_deleteMax :: IntSet -> Property
+prop_deleteMax a = not (null a) ==> toSet (deleteMax a) == Set.deleteMax (toSet a)
+
+prop_deleteFindMin :: IntSet -> Property
+prop_deleteFindMin a = not (null a) ==> (x, toSet y) == Set.deleteFindMin (toSet a) where
+  (x, y) = deleteFindMin a
+
+prop_deleteFindMax :: IntSet -> Property
+prop_deleteFindMax a = not (null a) ==> (x, toSet y) == Set.deleteFindMax (toSet a) where
+  (x, y) = deleteFindMax a
+
+prop_maxView :: IntSet -> Bool
+prop_maxView a = Prelude.map (\(x, y) -> (x, toSet y)) (maxView a) == Set.maxView (toSet a)
+
+prop_minView :: IntSet -> Bool
+prop_minView a = Prelude.map (\(x, y) -> (x, toSet y)) (minView a) == Set.minView (toSet a)
+
+prop_map :: (Int -> Int) -> IntSet -> Bool
+prop_map a b = toSet (map a b) == Set.map a (toSet b)
+
+prop_fold :: (Int -> Int -> Int) -> Int -> IntSet -> Bool
+prop_fold a b c = fold a b c == Set.fold a b (toSet c)
+
+-- The documentation for fold asserts this test.
+prop_fold2 :: IntSet -> Bool
+prop_fold2 set = elems set == fold (:) [] set
+
+prop_elems :: IntSet -> Bool
+prop_elems a = elems a == Set.elems (toSet a)
+
+prop_toList :: IntSet -> Bool
+prop_toList a = toList a == Set.toList (toSet a)
+
+prop_fromList :: [Int] -> Bool
+prop_fromList a = toSet (fromList a) == Set.fromList a
+
+prop_toAscList :: IntSet -> Bool
+prop_toAscList a = toAscList a == Set.toAscList (toSet a)
+
+prop_fromAscList :: [Int] -> Bool
+prop_fromAscList a = toSet (fromAscList b) == Set.fromAscList b where
+  b = List.sort a
+
+prop_fromDistinctAscList :: IntSet -> Bool
+prop_fromDistinctAscList a = toSet (fromDistinctAscList b) == Set.fromDistinctAscList b where
+  b = toAscList a 
+
+prop_compare :: IntSet -> IntSet -> Bool
+prop_compare a b = compare a b == compare (toSet a) (toSet b)
+
+prop_showsPrec :: Int -> IntSet -> String -> Bool
+prop_showsPrec a b c = showsPrec a b c == showsPrec a (toSet b) c
+
+test_all = do
+  qcheck prop_Single
+  qcheck prop_InsertDelete
+  qcheck prop_UnionInsert
+  qcheck prop_UnionAssoc
+  qcheck prop_UnionComm
+  qcheck prop_Diff
+  qcheck prop_Int
+  qcheck prop_Ordered
+  qcheck prop_List
+  qcheck prop_toSet
+  qcheck prop_bkbk
+  qcheck prop_null
+  qcheck prop_size
+  qcheck prop_member
+  qcheck prop_notMember
+  qcheck prop_isSubsetOf
+  qcheck prop_isSubsetOf2
+  qcheck prop_isProperSubsetOf
+  qcheck prop_isProperSubsetOf2
+  qcheck prop_empty
+  qcheck prop_singleton
+  qcheck prop_insert
+  qcheck prop_delete
+  qcheck prop_union
+  qcheck prop_unions
+  qcheck prop_difference
+  qcheck prop_intersection
+  qcheck prop_filter
+  qcheck prop_partition
+  qcheck prop_split
+  qcheck prop_splitMember
+  qcheck prop_findMin
+  qcheck prop_findMax
+  qcheck prop_deleteMin
+  qcheck prop_deleteMax
+  qcheck prop_deleteFindMin
+  qcheck prop_deleteFindMax
+  qcheck prop_maxView
+  qcheck prop_minView
+  qcheck prop_map
+  qcheck prop_fold
+  qcheck prop_fold2
+  qcheck prop_elems
+  qcheck prop_toList
+  qcheck prop_fromList
+  qcheck prop_toAscList
+  qcheck prop_fromAscList
+  qcheck prop_fromDistinctAscList
+  qcheck prop_compare
+  qcheck prop_showsPrec
+  qcheck prop_valid_bkbk
+  qcheck prop_valid_empty
+  qcheck prop_valid_singleton
+  qcheck prop_valid_insert
+  qcheck prop_valid_delete
+  qcheck prop_valid_union
+  qcheck prop_valid_unions
+  qcheck prop_valid_difference
+  qcheck prop_valid_intersection
+  qcheck prop_valid_filter
+  qcheck prop_valid_partition
+  qcheck prop_valid_split
+  qcheck prop_valid_splitMember
+  qcheck prop_valid_deleteMin
+  qcheck prop_valid_deleteMax
+  qcheck prop_valid_deleteFindMin
+  qcheck prop_valid_deleteFindMax
+  qcheck prop_valid_maxView
+  qcheck prop_valid_minView
+  qcheck prop_valid_map
+  qcheck prop_valid_fromList
+  qcheck prop_valid_fromAscList
+  qcheck prop_valid_fromDistinctAscList
}

Context:

[Fix a link in haddock docs
Ian Lynagh <igloo at earth.li>**20071126184450] 
[Fix some URLs
Ian Lynagh <igloo at earth.li>**20071126214233] 
[Add tiny regression test
David Benbennick <dbenbenn at gmail.com>**20071113045358] 
[Fix ticket 1762
David Benbennick <dbenbenn at gmail.com>**20071111201939] 
[Specify build-type: Simple
Duncan Coutts <duncan at haskell.org>**20071018125404] 
[Add a boring file
Ian Lynagh <igloo at earth.li>**20070913204647] 
[TAG 2007-09-13
Ian Lynagh <igloo at earth.li>**20070913215901] 
Patch bundle hash:
81cd649b2d127d179f8a70c68b0588c93debd934


More information about the Libraries mailing list