Browse files

Add second regression test for issue #39

Contributed by Gabriele Sales.
  • Loading branch information...
1 parent b41aaca commit 0b7ef83158f6b5a5c687ea5f6c22f57f6f701fbb @tibbe committed Oct 10, 2012
Showing with 55 additions and 2 deletions.
  1. +53 −2 tests/Regressions.hs
  2. +2 −0 unordered-containers.cabal
View
55 tests/Regressions.hs
@@ -1,18 +1,28 @@
module Main where
+import Control.Applicative ((<$>))
+import Control.Monad (replicateM)
import qualified Data.HashMap.Strict as HM
+import Data.List (delete)
import Data.Maybe
import Test.HUnit (Assertion, assert)
import Test.Framework (Test, defaultMain)
import Test.Framework.Providers.HUnit (testCase)
+import Test.Framework.Providers.QuickCheck2 (testProperty)
+import Test.QuickCheck
issue32 :: Assertion
issue32 = assert $ isJust $ HM.lookup 7 m'
where
ns = [0..16] :: [Int]
- m = HM.fromList (zip ns (repeat []))
+ m = HM.fromList (zip ns (repeat []))
m' = HM.delete 10 m
+------------------------------------------------------------------------
+-- Issue #39
+
+-- First regression
+
issue39 :: Assertion
issue39 = assert $ hm1 == hm2
where
@@ -21,14 +31,55 @@ issue39 = assert $ hm1 == hm2
a = (1, -1) :: (Int, Int)
b = (-1, 1) :: (Int, Int)
+-- Second regression
+
+newtype Keys = Keys [Int]
+ deriving Show
+
+instance Arbitrary Keys where
+ arbitrary = sized $ \l -> do
+ pis <- replicateM (l+1) positiveInt
+ return (Keys $ prefixSum pis)
+
+ shrink (Keys ls) =
+ let l = length ls
+ in if l == 1
+ then []
+ else [ Keys (dropAt i ls) | i <- [0..l-1] ]
+
+positiveInt :: Gen Int
+positiveInt = (+1) . abs <$> arbitrary
+
+prefixSum :: [Int] -> [Int]
+prefixSum = loop 0
+ where
+ loop _ [] = []
+ loop prefix (l:ls) = let n = l + prefix
+ in n : loop n ls
+
+dropAt :: Int -> [a] -> [a]
+dropAt _ [] = []
+dropAt i (l:ls) | i == 0 = ls
+ | otherwise = l : dropAt (i-1) ls
+
+propEqAfterDelete :: Keys -> Bool
+propEqAfterDelete (Keys keys) =
+ let keyMap = mapFromKeys keys
+ k = head keys
+ in HM.delete k keyMap == mapFromKeys (delete k keys)
+
+mapFromKeys :: [Int] -> HM.HashMap Int ()
+mapFromKeys keys = HM.fromList (zip keys (repeat ()))
+
------------------------------------------------------------------------
-- * Test list
tests :: [Test]
tests =
[
testCase "issue32" issue32
- , testCase "issue39" issue39
+ , testCase "issue39a" issue39
+ , testProperty "issue39b" propEqAfterDelete
]
------------------------------------------------------------------------
View
2 unordered-containers.cabal
@@ -112,8 +112,10 @@ test-suite regressions
base,
hashable >= 1.0.1.1,
HUnit,
+ QuickCheck >= 2.4.0.1,
test-framework >= 0.3.3,
test-framework-hunit,
+ test-framework-quickcheck2,
unordered-containers
ghc-options: -Wall

0 comments on commit 0b7ef83

Please sign in to comment.