Skip to content

Commit b0bf694

Browse files
m-renaudtreeowl
authored andcommitted
Fix IntSet and IntMap validity tests. (#530)
The previous implementations only checked the commonPrefix and maskRespected invariant for the top level Bin constructor and didn't appropriately recurse into subtrees. This resolves #522.
1 parent cfb1367 commit b0bf694

File tree

2 files changed

+10
-6
lines changed

2 files changed

+10
-6
lines changed

tests/IntMapValidity.hs

Lines changed: 5 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -46,10 +46,10 @@ commonPrefix t =
4646
case t of
4747
Nil -> True
4848
Tip _ _ -> True
49-
b@(Bin p _ _ _) -> all (sharedPrefix p) (keys b)
49+
b@(Bin p _ l r) -> all (sharedPrefix p) (keys b) && commonPrefix l && commonPrefix r
5050
where
5151
sharedPrefix :: Prefix -> Int -> Bool
52-
sharedPrefix p a = 0 == (p `xor` (p .&. a))
52+
sharedPrefix p a = p == p .&. a
5353

5454
-- Invariant: In Bin prefix mask left right, left consists of the elements that
5555
-- don't have the mask bit set; right is all the elements that do.
@@ -60,4 +60,6 @@ maskRespected t =
6060
Tip _ _ -> True
6161
Bin _ binMask l r ->
6262
all (\x -> zero x binMask) (keys l) &&
63-
all (\x -> not (zero x binMask)) (keys r)
63+
all (\x -> not (zero x binMask)) (keys r) &&
64+
maskRespected l &&
65+
maskRespected r

tests/IntSetValidity.hs

Lines changed: 5 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -49,10 +49,10 @@ commonPrefix t =
4949
case t of
5050
Nil -> True
5151
Tip _ _ -> True
52-
b@(Bin p _ _ _) -> all (sharedPrefix p) (elems b)
52+
b@(Bin p _ l r) -> all (sharedPrefix p) (elems b) && commonPrefix l && commonPrefix r
5353
where
5454
sharedPrefix :: Prefix -> Int -> Bool
55-
sharedPrefix p a = 0 == (p `xor` (p .&. a))
55+
sharedPrefix p a = p == p .&. a
5656

5757
-- Invariant: In Bin prefix mask left right, left consists of the elements that
5858
-- don't have the mask bit set; right is all the elements that do.
@@ -63,7 +63,9 @@ maskRespected t =
6363
Tip _ _ -> True
6464
Bin _ binMask l r ->
6565
all (\x -> zero x binMask) (elems l) &&
66-
all (\x -> not (zero x binMask)) (elems r)
66+
all (\x -> not (zero x binMask)) (elems r) &&
67+
maskRespected l &&
68+
maskRespected r
6769

6870
-- Invariant: The Prefix is zero for the last 5 (on 32 bit arches) or 6 bits
6971
-- (on 64 bit arches). The values of the set represented by a tip

0 commit comments

Comments
 (0)