QuickCheck properties for IntSet
David Benbennick
dbenbenn at gmail.com
Sat Dec 8 05:18:31 EST 2007
Here's an improved version of the patch. It adds 11 more QuickCheck
properties. Now everything is tested except:
* The Data instance for IntSet (does anyone know how to test that?)
* The debugging functions showTree and showTreeWith
* The various read functions (read, readList, reads, readsPrec) are
not that well tested, especially parse failures.
I found that IntSet.showTree and IntSet.showTreeWith are not identical
to Set.showTree and Set.showTreeWith. Not a big deal since they're
just debugging functions, I guess. But it means I can't include
QuickCheck properties for them.
I commented out some code that could never be executed:
* Some case-statement cases that could never occur.
* >>= for the Identity monad used internally.
union had an odd comment about "right bias". I understand how right
bias and left bias can be different in a generic container like Set
(since the Eq instance for the contained type might not be structural
equality). But for IntSet, there's no way to distinguish different
copies of the number 7. In any case, the documentation at
http://www.haskell.org/ghc/docs/latest/html/libraries/containers-0.1.0.0/Data-IntSet.html#v%3Aunion
doesn't mention anything about bias. So I took out insertR, the
function that implemented "right bias".
If this patch is accepted, I intend to work on QuickCheck properties
for Data.Set next.
-------------- 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
}
[more QuickCheck properties
David Benbennick <dbenbenn at gmail.com>**20071208093646
Add more QuickCheck properties. The only code that remains untested is
1) The Data instance
2) The debugging functions that print IntSets in various ways
Also remove insertR: the documentation doesn't specify "right bias" for union, and in any case "right bias" doesn't mean anything for an IntSet.
And comment out 4 lines of code that could never be executed.
] {
hunk ./Data/IntSet.hs 281
--- right-biased insertion, used by 'union'
-insertR :: Int -> IntSet -> IntSet
-insertR x t
- = case t of
- Bin p m l r
- | nomatch x p m -> join x (Tip x) p t
- | zero x m -> Bin p m (insert x l) r
- | otherwise -> Bin p m l (insert x r)
- Tip y
- | x==y -> t
- | otherwise -> join x (Tip x) y t
- Nil -> Tip x
-
hunk ./Data/IntSet.hs 322
-union t (Tip x) = insertR x t -- right bias
+union t (Tip x) = insert x t -- right bias
hunk ./Data/IntSet.hs 499
- Nil -> (Nil,Nil)
+ -- Nil -> (Nil,Nil) -- This case can't happen.
hunk ./Data/IntSet.hs 529
- Nil -> (Nil,False,Nil)
+ -- Nil -> (Nil,False,Nil) -- This case can't happen
hunk ./Data/IntSet.hs 572
- m >>= k = k (runIdentity m)
+ -- m >>= k = k (runIdentity m) -- Not used
hunk ./Data/IntSet.hs 639
- Nil -> z
+ -- Nil -> z -- This case can't happen
hunk ./Data/IntSet.hs 1064
+prop_mempty :: Bool
+prop_mempty = toSet mempty == mempty
+
+prop_mappend :: IntSet -> IntSet -> Bool
+prop_mappend a b = toSet (mappend a b) == mappend (toSet a) (toSet b)
+
+prop_mconcat :: [IntSet] -> Bool
+prop_mconcat a = toSet (mconcat a) == mconcat (Prelude.map toSet a)
+
hunk ./Data/IntSet.hs 1211
+prop_equal :: IntSet -> IntSet -> Bool
+prop_equal a b = (a == b) == (toSet a == toSet b)
+
+prop_nequal :: IntSet -> IntSet -> Bool
+prop_nequal a b = (a /= b) == (toSet a /= toSet b)
+
hunk ./Data/IntSet.hs 1220
+prop_show :: IntSet -> Bool
+prop_show a = show a == show (toSet a)
+
+prop_read :: IntSet -> Bool
+prop_read a = read (show a) == a
+
+prop_readList :: [IntSet] -> Bool
+prop_readList a = readList (show a) == [(a, "")]
+
+prop_typeOf :: IntSet -> Bool
+prop_typeOf a = show (typeOf a) == "IntSet"
+
+data Error a = Error String deriving Eq
+instance Monad Error where
+ fail s = Error s
+
+prop_maxView_error :: Bool
+prop_maxView_error = maxView empty == Error "maxView: empty set has no maximal element"
+
+prop_minView_error :: Bool
+prop_minView_error = minView empty == Error "minView: empty set has no minimal element"
+
hunk ./Data/IntSet.hs 1254
+ qcheck prop_mempty
+ qcheck prop_mappend
+ qcheck prop_mconcat
hunk ./Data/IntSet.hs 1295
+ qcheck prop_equal
+ qcheck prop_nequal
hunk ./Data/IntSet.hs 1298
+ qcheck prop_show
+ qcheck prop_read
+ qcheck prop_readList
+ qcheck prop_typeOf
+ qcheck prop_maxView_error
+ qcheck prop_minView_error
}
[Remove explicit instance of Eq, use deriving instead
David Benbennick <dbenbenn at gmail.com>**20071208094555] {
hunk ./Data/IntSet.hs 169
+ deriving Eq
hunk ./Data/IntSet.hs 679
-
-{--------------------------------------------------------------------
- Eq
---------------------------------------------------------------------}
-instance Eq IntSet where
- t1 == t2 = equal t1 t2
- t1 /= t2 = nequal t1 t2
-
-equal :: IntSet -> IntSet -> Bool
-equal (Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)
- = (m1 == m2) && (p1 == p2) && (equal l1 l2) && (equal r1 r2)
-equal (Tip x) (Tip y)
- = (x==y)
-equal Nil Nil = True
-equal t1 t2 = False
-
-nequal :: IntSet -> IntSet -> Bool
-nequal (Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)
- = (m1 /= m2) || (p1 /= p2) || (nequal l1 l2) || (nequal r1 r2)
-nequal (Tip x) (Tip y)
- = (x/=y)
-nequal Nil Nil = False
-nequal t1 t2 = True
-
}
[Better prop_typeOf test
David Benbennick <dbenbenn at gmail.com>**20071208095158] {
hunk ./Data/IntSet.hs 1206
-prop_typeOf :: IntSet -> Bool
-prop_typeOf a = show (typeOf a) == "IntSet"
+prop_typeOf :: Bool
+prop_typeOf = show (typeOf (undefined :: IntSet)) == "IntSet"
}
[Remove obsolete comment
David Benbennick <dbenbenn at gmail.com>**20071208100137] {
hunk ./Data/IntSet.hs 323
-union t (Tip x) = insert x t -- right bias
+union t (Tip x) = insert x t
}
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:
0baa692614c35a3ddbbd4524ebed85dead7177d6
More information about the Libraries
mailing list