Fix buggy restrictKeys and withoutKeys (#393)
authorDavid Feuer <David.Feuer@gmail.com>
Mon, 6 Feb 2017 21:07:33 +0000 (16:07 -0500)
committerGitHub <noreply@github.com>
Mon, 6 Feb 2017 21:07:33 +0000 (16:07 -0500)
`restrictKeys` and `withoutKeys` for `Data.IntMap` were completely
wrong. The QuickCheck properties that should have caught this were
never actually run.

* Fix the implementations

* Make the tests actually run.

Fixes #392

Data/IntMap/Internal.hs
tests/intmap-properties.hs

index b42aab1..c3fe437 100644 (file)
@@ -1058,30 +1058,14 @@ withoutKeys = go
                | zero p1 m2        = bin p2 m2 (go t1 l2) Nil
                | otherwise         = bin p2 m2 Nil (go t1 r2)
 
-    go t1'@(Bin _ _ _ _) t2'@(IntSet.Tip k2' _) = merge0 t2' k2' t1'
-      where
-        merge0 t2 k2 t1@(Bin p1 m1 l1 r1)
-          | nomatch k2 p1 m1 = t1
-          | zero k2 m1 = binCheckLeft p1 m1 (merge0 t2 k2 l1) r1
-          | otherwise  = binCheckRight p1 m1 l1 (merge0 t2 k2 r1)
-        merge0 _ k2 t1@(Tip k1 _)
-          | k1 == k2 = Nil
-          | otherwise = t1
-        merge0 _ _  Nil = Nil
+    go t1'@(Bin _ _ _ _) t2'@(IntSet.Tip _ _) =
+      filterWithKey (\k _ -> k `IntSet.notMember` t2') t1'
 
     go t1@(Bin _ _ _ _) IntSet.Nil = t1
 
-    go t1'@(Tip k1' _) t2' = merge0 t1' k1' t2'
-      where
-        merge0 t1 k1 (IntSet.Bin p2 m2 l2 r2)
-          | nomatch k1 p2 m2 = t1
-          | zero k1 m2 = bin p2 m2 (merge0 t1 k1 l2) Nil
-          | otherwise  = bin p2 m2 Nil (merge0 t1 k1 r2)
-        merge0 t1 k1 (IntSet.Tip k2 _)
-          | k1 == k2 = Nil
-          | otherwise = t1
-        merge0 t1 _  IntSet.Nil = t1
-
+    go t1'@(Tip k1' _) t2'
+      | k1' `IntSet.member` t2' = Nil
+      | otherwise = t1'
     go Nil _ = Nil
 
 
@@ -1119,30 +1103,13 @@ restrictKeys = go
                | zero p1 m2        = bin p2 m2 (go t1 l2) Nil
                | otherwise         = bin p2 m2 Nil (go t1 r2)
 
-    go t1'@(Bin _ _ _ _) t2'@(IntSet.Tip k2' _) = merge0 t2' k2' t1'
-      where
-        merge0 t2 k2 (Bin p1 m1 l1 r1)
-          | nomatch k2 p1 m1 = Nil
-          | zero k2 m1 = bin p1 m1 (merge0 t2 k2 l1) Nil
-          | otherwise  = bin p1 m1 Nil (merge0 t2 k2 r1)
-        merge0 _ k2 t1@(Tip k1 _)
-          | k1 == k2 = t1
-          | otherwise = Nil
-        merge0 _ _  Nil = Nil
-
+    go t1'@(Bin _ _ _ _) t2'@(IntSet.Tip _ _) =
+      filterWithKey (\k _ -> k `IntSet.member` t2') t1'
     go (Bin _ _ _ _) IntSet.Nil = Nil
 
-    go t1'@(Tip k1' _) t2' = merge0 t1' k1' t2'
-      where
-        merge0 t1 k1 (IntSet.Bin p2 m2 l2 r2)
-          | nomatch k1 p2 m2 = Nil
-          | zero k1 m2 = bin p2 m2 (merge0 t1 k1 l2) Nil
-          | otherwise  = bin p2 m2 Nil (merge0 t1 k1 r2)
-        merge0 t1 k1 (IntSet.Tip k2 _)
-          | k1 == k2 = t1
-          | otherwise = Nil
-        merge0 _ _  IntSet.Nil = Nil
-
+    go t1'@(Tip k1' _) t2'
+      | k1' `IntSet.member` t2' = t1'
+      | otherwise = Nil
     go Nil _ = Nil
 
 -- | /O(n+m)/. The intersection with a combining function.
index 21ee9f6..a6fbe2f 100644 (file)
@@ -167,6 +167,8 @@ main = defaultMain
              , testProperty "foldl'"               prop_foldl'
              , testProperty "keysSet"              prop_keysSet
              , testProperty "fromSet"              prop_fromSet
+             , testProperty "restrictKeys"         prop_restrictKeys
+             , testProperty "withoutKeys"          prop_withoutKeys
              ]
 
 apply2 :: Fun (a, b) c -> a -> b -> c