QuickCheck 2.13.2 → 2.14

raw patch · 9 files changed

+221/−52 lines, 9 filesdep ~splitmixPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: splitmix

API changes (from Hackage documentation)

Files

• QuickCheck.cabal +4/−4
• Test/QuickCheck.hs +5/−0
• Test/QuickCheck/Arbitrary.hs +52/−35
• Test/QuickCheck/Function.hs +6/−0
• Test/QuickCheck/Gen.hs +99/−11
• Test/QuickCheck/Property.hs +1/−1
• changelog +43/−0
• make-hugs +1/−1
• tests/Generators.hs +10/−0

@@ -1,5 +1,5 @@ Name: QuickCheck-Version: 2.13.2+Version: 2.14 Cabal-Version: >= 1.8 Build-type: Simple License: BSD3@@ -56,7 +56,7 @@ source-repository this   type:     git   location: https://github.com/nick8325/quickcheck-  tag:      2.13.2+  tag:      2.14  flag templateHaskell   Description: Build Test.QuickCheck.All, which uses Template Haskell.@@ -120,7 +120,7 @@    -- Use splitmix on newer GHCs.   if impl(ghc >= 7.0)-    Build-depends: splitmix >= 0.0.2+    Build-depends: splitmix >= 0.0.4   else     cpp-options: -DNO_SPLITMIX @@ -134,7 +134,7 @@   if !impl(ghc)     -- If your Haskell compiler can cope without some of these, please     -- send a message to the QuickCheck mailing list!-    cpp-options: -DNO_TIMEOUT -DNO_NEWTYPE_DERIVING -DNO_GENERICS -DNO_TEMPLATE_HASKELL -DNO_SAFE_HASKELL -DNO_TYPEABLE -DNO_GADTS+    cpp-options: -DNO_TIMEOUT -DNO_NEWTYPE_DERIVING -DNO_GENERICS -DNO_TEMPLATE_HASKELL -DNO_SAFE_HASKELL -DNO_TYPEABLE -DNO_GADTS -DNO_EXTRA_METHODS_IN_APPLICATIVE     if !impl(hugs) && !impl(uhc)       cpp-options: -DNO_ST_MONAD -DNO_MULTI_PARAM_TYPE_CLASSES 

@@ -95,6 +95,11 @@   , Gen     -- ** Generator combinators   , choose+  , chooseInt+  , chooseInteger+  , chooseBoundedIntegral+  , chooseEnum+  , chooseAny   , oneof   , frequency   , elements

@@ -55,6 +55,8 @@   , arbitraryPrintableChar -- :: Gen Char   -- ** Helper functions for implementing shrink #ifndef NO_GENERICS+  , RecursivelyShrink+  , GSubterms   , genericShrink      -- :: (Generic a, Arbitrary a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) => a -> [a]   , subterms           -- :: (Generic a, Arbitrary a, GSubterms (Rep a) a) => a -> [a]   , recursivelyShrink  -- :: (Generic a, RecursivelyShrink (Rep a)) => a -> [a]@@ -157,6 +159,7 @@ import qualified Data.IntSet as IntSet import qualified Data.IntMap as IntMap import qualified Data.Sequence as Sequence+import Data.Bits  import qualified Data.Monoid as Monoid @@ -412,7 +415,7 @@   arbitrary = return ()  instance Arbitrary Bool where-  arbitrary = choose (False,True)+  arbitrary = chooseEnum (False,True)   shrink True = [False]   shrink False = [] @@ -485,7 +488,11 @@   arbitrary = arbitrarySizedFractional   shrink    = shrinkRealFrac +#if defined(MIN_VERSION_base) && MIN_VERSION_base(4,4,0)+instance Arbitrary a => Arbitrary (Complex a) where+#else instance (RealFloat a, Arbitrary a) => Arbitrary (Complex a) where+#endif   arbitrary = liftM2 (:+) arbitrary arbitrary   shrink (x :+ y) = [ x' :+ y | x' <- shrink x ] ++                     [ x :+ y' | y' <- shrink y ]@@ -634,7 +641,7 @@   shrink    = shrinkIntegral  instance Arbitrary Word where-  arbitrary = arbitrarySizedIntegral+  arbitrary = arbitrarySizedNatural   shrink    = shrinkIntegral  instance Arbitrary Word8 where@@ -926,7 +933,7 @@ -- | Generates 'Version' with non-empty non-negative @versionBranch@, and empty @versionTags@ instance Arbitrary Version where   arbitrary = sized $ \n ->-    do k <- choose (0, log2 n)+    do k <- chooseInt (0, log2 n)        xs <- vectorOf (k+1) arbitrarySizedNatural        return (Version xs [])     where@@ -975,17 +982,17 @@ arbitrarySizedIntegral :: Integral a => Gen a arbitrarySizedIntegral =   sized $ \n ->-  inBounds fromInteger (choose (-toInteger n, toInteger n))+  inBounds fromIntegral (chooseInt (-n, n))  -- | Generates a natural number. The number's maximum value depends on -- the size parameter. arbitrarySizedNatural :: Integral a => Gen a arbitrarySizedNatural =   sized $ \n ->-  inBounds fromInteger (choose (0, toInteger n))+  inBounds fromIntegral (chooseInt (0, n)) -inBounds :: Integral a => (Integer -> a) -> Gen Integer -> Gen a-inBounds fi g = fmap fi (g `suchThat` (\x -> toInteger (fi x) == x))+inBounds :: Integral a => (Int -> a) -> Gen Int -> Gen a+inBounds fi g = fmap fi (g `suchThat` (\x -> toInteger x == toInteger (fi x)))  -- | Generates a fractional number. The number can be positive or negative -- and its maximum absolute value depends on the size parameter.@@ -993,14 +1000,15 @@ arbitrarySizedFractional =   sized $ \n ->     let n' = toInteger n in-      do b <- choose (1, precision)-         a <- choose ((-n') * b, n' * b)+      do b <- chooseInteger (1, precision)+         a <- chooseInteger ((-n') * b, n' * b)          return (fromRational (a % b))  where   precision = 9999999999999 :: Integer  -- Useful for getting at minBound and maxBound without having to -- fiddle around with asTypeOf.+{-# INLINE withBounds #-} withBounds :: Bounded a => (a -> a -> Gen a) -> Gen a withBounds k = k minBound maxBound @@ -1008,10 +1016,7 @@ -- the entire range of the type. You may want to use -- 'arbitrarySizedBoundedIntegral' instead. arbitraryBoundedIntegral :: (Bounded a, Integral a) => Gen a-arbitraryBoundedIntegral =-  withBounds $ \mn mx ->-  do n <- choose (toInteger mn, toInteger mx)-     return (fromInteger n)+arbitraryBoundedIntegral = chooseBoundedIntegral (minBound, maxBound)  -- | Generates an element of a bounded type. The element is -- chosen from the entire range of the type.@@ -1020,44 +1025,52 @@  -- | Generates an element of a bounded enumeration. arbitraryBoundedEnum :: (Bounded a, Enum a) => Gen a-arbitraryBoundedEnum =-  withBounds $ \mn mx ->-  do n <- choose (fromEnum mn, fromEnum mx)-     return (toEnum n)+arbitraryBoundedEnum = chooseEnum (minBound, maxBound)  -- | Generates an integral number from a bounded domain. The number is -- chosen from the entire range of the type, but small numbers are -- generated more often than big numbers. Inspired by demands from -- Phil Wadler. arbitrarySizedBoundedIntegral :: (Bounded a, Integral a) => Gen a+-- INLINEABLE so that this combinator gets specialised at each type,+-- which means that the constant 'bits' in the let-block below will+-- only be computed once.+{-# INLINEABLE arbitrarySizedBoundedIntegral #-} arbitrarySizedBoundedIntegral =   withBounds $ \mn mx ->-  sized $ \s ->-    do let bits n | n == 0 = 0-                  | otherwise = 1 + bits (n `quot` 2)-           k = (toInteger s*(bits mn `max` bits mx `max` 40) `div` 80)-           -- computes x `min` (2^k), but avoids computing 2^k-           -- if it is too large-           x `minexp` k-             | bits x < k = x-             | otherwise = x `min` (2^k)-           -- x `max` (-2^k)-           x `maxexpneg` k = -((-x) `minexp` k)-       n <- choose (toInteger mn `maxexpneg` k, toInteger mx `minexp` k)-       return (fromInteger n)+  let ilog2 1 = 0+      ilog2 n | n > 0 = 1 + ilog2 (n `div` 2) +      -- How many bits are needed to represent this type?+      -- (This number is an upper bound, not exact.)+      bits = ilog2 (toInteger mx - toInteger mn + 1) in+  sized $ \k ->+    let+      -- Reach maximum size by k=80, or quicker for small integer types+      power = ((bits `max` 40) * k) `div` 80++      -- Bounds should be 2^power, but:+      --   * clamp the result to minBound/maxBound+      --   * clamp power to 'bits', in case k is a huge number+      lo = toInteger mn `max` (-1 `shiftL` (power `min` bits))+      hi = toInteger mx `min` (1 `shiftL` (power `min` bits)) in+    fmap fromInteger (chooseInteger (lo, hi))+ -- ** Generators for various kinds of character  -- | Generates any Unicode character (but not a surrogate) arbitraryUnicodeChar :: Gen Char arbitraryUnicodeChar =-  arbitraryBoundedEnum `suchThat` (not . isSurrogate)+  arbitraryBoundedEnum `suchThat` isValidUnicode   where-    isSurrogate c = generalCategory c == Surrogate+    isValidUnicode c = case generalCategory c of+      Surrogate -> False+      NotAssigned -> False+      _ -> True  -- | Generates a random ASCII character (0-127). arbitraryASCIIChar :: Gen Char-arbitraryASCIIChar = choose ('\0', '\127')+arbitraryASCIIChar = chooseEnum ('\0', '\127')  -- | Generates a printable Unicode character. arbitraryPrintableChar :: Gen Char@@ -1131,7 +1144,7 @@ shrinkDecimal :: RealFrac a => a -> [a] shrinkDecimal x   | not (x == x)  = 0 : take 10 (iterate (*2) 0)        -- NaN-  | not (2*x+1>x) = 0 : takeWhile (<x) (iterate (*2) 0) -- infinity+  | not (2*abs x+1>abs x) = 0 : takeWhile (<x) (iterate (*2) 0) -- infinity   | otherwise =     -- e.g. shrink pi =     --   shrink 3 ++ map (/ 10) (shrink 31) ++@@ -1140,7 +1153,7 @@     [ y     | precision <- take 6 (iterate (*10) 1),       let m = round (toRational x * precision),-      m `mod` 10 /= 0, -- don't allow shrinking to increase digits+      precision == 1 || m `mod` 10 /= 0, -- don't allow shrinking to increase digits       n <- m:shrink m,       let y = fromRational (fromInteger n / precision),       abs y < abs x ]@@ -1255,7 +1268,11 @@   coarbitrary = coarbitraryReal #endif +#if defined(MIN_VERSION_base) && MIN_VERSION_base(4,4,0)+instance CoArbitrary a => CoArbitrary (Complex a) where+#else instance (RealFloat a, CoArbitrary a) => CoArbitrary (Complex a) where+#endif   coarbitrary (x :+ y) = coarbitrary x . coarbitrary y  instance (CoArbitrary a, CoArbitrary b)

@@ -49,6 +49,9 @@   , functionRealFrac   , functionBoundedEnum   , functionVoid+  , functionMapWith+  , functionEitherWith+  , functionPairWith #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708   , pattern Fn   , pattern Fn2@@ -188,6 +191,7 @@ functionMap :: Function b => (a->b) -> (b->a) -> (a->c) -> (a:->c) functionMap = functionMapWith function +-- | @since 2.13.3 functionMapWith :: ((b->c) -> (b:->c)) -> (a->b) -> (b->a) -> (a->c) -> (a:->c) functionMapWith function g h f = Map g h (function (\b -> f (h b))) @@ -203,12 +207,14 @@ instance (Function a, Function b) => Function (a,b) where   function = functionPairWith function function +-- | @since 2.13.3 functionPairWith :: ((a->b->c) -> (a:->(b->c))) -> ((b->c) -> (b:->c)) -> ((a,b)->c) -> ((a,b):->c) functionPairWith func1 func2 f = Pair (func2 `fmap` func1 (curry f))  instance (Function a, Function b) => Function (Either a b) where   function = functionEitherWith function function +-- | @since 2.13.3 functionEitherWith :: ((a->c) -> (a:->c)) -> ((b->c) -> (b:->c)) -> (Either a b->c) -> (Either a b:->c) functionEitherWith func1 func2 f = func1 (f . Left) :+: func2 (f . Right) 

@@ -35,6 +35,13 @@ import Data.List import Data.Ord import Data.Maybe+#ifndef NO_SPLITMIX+import System.Random.SplitMix(bitmaskWithRejection64', SMGen)+#endif+import Data.Word+import Data.Int+import Data.Bits+import Control.Applicative  -------------------------------------------------------------------------- -- ** Generator type@@ -56,12 +63,18 @@     MkGen (\r n -> f (h r n))  instance Applicative Gen where-  pure  = return-  gf <*> gx = gf >>= \f -> fmap f gx+  pure x =+    MkGen (\_ _ -> x)+  (<*>) = ap +#ifndef NO_EXTRA_METHODS_IN_APPLICATIVE+  -- We don't need to split the seed for these.+  _ *> m = m+  m <* _ = m+#endif+ instance Monad Gen where-  return x =-    MkGen (\_ _ -> x)+  return = pure    MkGen m >>= k =     MkGen (\r n ->@@ -71,6 +84,8 @@           in m' r2 n     ) +  (>>) = (*>)+ instance MonadFix Gen where   mfix f =     MkGen $ \r n ->@@ -126,6 +141,8 @@ scale f g = sized (\n -> resize (f n) g)  -- | Generates a random element in the given inclusive range.+-- For integral and enumerated types, the specialised variants of+-- 'choose' below run much quicker. choose :: Random a => (a,a) -> Gen a choose rng = MkGen (\r _ -> let (x,_) = randomR rng r in x) @@ -133,6 +150,77 @@ chooseAny :: Random a => Gen a chooseAny = MkGen (\r _ -> let (x,_) = random r in x) +-- | A fast implementation of 'choose' for enumerated types.+chooseEnum :: Enum a => (a, a) -> Gen a+chooseEnum (lo, hi) =+  fmap toEnum (chooseInt (fromEnum lo, fromEnum hi))++-- | A fast implementation of 'choose' for 'Int'.+chooseInt :: (Int, Int) -> Gen Int+chooseInt = chooseBoundedIntegral++-- Note about INLINEABLE: we specialise chooseBoundedIntegral+-- for each concrete type, so that all the bounds checks get+-- simplified away.+{-# INLINEABLE chooseBoundedIntegral #-}+-- | A fast implementation of 'choose' for bounded integral types.+chooseBoundedIntegral :: (Bounded a, Integral a) => (a, a) -> Gen a+chooseBoundedIntegral (lo, hi)+#ifndef NO_SPLITMIX+  | toInteger mn >= toInteger (minBound :: Int64) &&+    toInteger mx <= toInteger (maxBound :: Int64) =+      fmap fromIntegral (chooseInt64 (fromIntegral lo, fromIntegral hi))+  | toInteger mn >= toInteger (minBound :: Word64) &&+    toInteger mx <= toInteger (maxBound :: Word64) =+      fmap fromIntegral (chooseWord64 (fromIntegral lo, fromIntegral hi))+#endif+  | otherwise =+      fmap fromInteger (chooseInteger (toInteger lo, toInteger hi))+#ifndef NO_SPLITMIX+  where+    mn = minBound `asTypeOf` lo+    mx = maxBound `asTypeOf` hi+#endif++-- | A fast implementation of 'choose' for 'Integer'.+chooseInteger :: (Integer, Integer) -> Gen Integer+#ifdef NO_SPLITMIX+chooseInteger = choose+#else+chooseInteger (lo, hi)+  | lo >= toInteger (minBound :: Int64) && lo <= toInteger (maxBound :: Int64) &&+    hi >= toInteger (minBound :: Int64) && hi <= toInteger (maxBound :: Int64) =+    fmap toInteger (chooseInt64 (fromInteger lo, fromInteger hi))+  | lo >= toInteger (minBound :: Word64) && lo <= toInteger (maxBound :: Word64) &&+    hi >= toInteger (minBound :: Word64) && hi <= toInteger (maxBound :: Word64) =+    fmap toInteger (chooseWord64 (fromInteger lo, fromInteger hi))+  | otherwise = choose (lo, hi)++chooseWord64 :: (Word64, Word64) -> Gen Word64+chooseWord64 (lo, hi)+  | lo <= hi = chooseWord64' (lo, hi)+  | otherwise = chooseWord64' (hi, lo)+  where+    chooseWord64' :: (Word64, Word64) -> Gen Word64+    chooseWord64' (lo, hi) =+      fmap (+ lo) (chooseUpTo (hi - lo))++chooseInt64 :: (Int64, Int64) -> Gen Int64+chooseInt64 (lo, hi)+  | lo <= hi = chooseInt64' (lo, hi)+  | otherwise = chooseInt64' (hi, lo)+  where+    chooseInt64' :: (Int64, Int64) -> Gen Int64+    chooseInt64' (lo, hi) = do+      w <- chooseUpTo (fromIntegral hi - fromIntegral lo)+      return (fromIntegral (w + fromIntegral lo))++chooseUpTo :: Word64 -> Gen Word64+chooseUpTo n =+  MkGen $ \(QCGen g) _ ->+    fst (bitmaskWithRejection64' n g)+#endif+ -- | Run a generator. The size passed to the generator is always 30; -- if you want another size then you should explicitly use 'resize'. generate :: Gen a -> IO a@@ -183,7 +271,7 @@ -- must be non-empty. oneof :: [Gen a] -> Gen a oneof [] = error "QuickCheck.oneof used with empty list"-oneof gs = choose (0,length gs - 1) >>= (gs !!)+oneof gs = chooseInt (0,length gs - 1) >>= (gs !!)  -- | Chooses one of the given generators, with a weighted random distribution. -- The input list must be non-empty.@@ -194,7 +282,7 @@     error "QuickCheck.frequency: negative weight"   | all (== 0) (map fst xs) =     error "QuickCheck.frequency: all weights were zero"-frequency xs0 = choose (1, tot) >>= (`pick` xs0)+frequency xs0 = chooseInt (1, tot) >>= (`pick` xs0)  where   tot = sum (map fst xs0) @@ -206,16 +294,16 @@ -- | Generates one of the given values. The input list must be non-empty. elements :: [a] -> Gen a elements [] = error "QuickCheck.elements used with empty list"-elements xs = (xs !!) `fmap` choose (0, length xs - 1)+elements xs = (xs !!) `fmap` chooseInt (0, length xs - 1)  -- | Generates a random subsequence of the given list. sublistOf :: [a] -> Gen [a]-sublistOf xs = filterM (\_ -> choose (False, True)) xs+sublistOf xs = filterM (\_ -> chooseEnum (False, True)) xs  -- | Generates a random permutation of the given list. shuffle :: [a] -> Gen [a] shuffle xs = do-  ns <- vectorOf (length xs) (choose (minBound :: Int, maxBound))+  ns <- vectorOf (length xs) (chooseInt (minBound :: Int, maxBound))   return (map snd (sortBy (comparing fst) (zip ns xs)))  -- | Takes a list of elements of increasing size, and chooses@@ -242,14 +330,14 @@ -- size parameter. listOf :: Gen a -> Gen [a] listOf gen = sized $ \n ->-  do k <- choose (0,n)+  do k <- chooseInt (0,n)      vectorOf k gen  -- | Generates a non-empty list of random length. The maximum length -- depends on the size parameter. listOf1 :: Gen a -> Gen [a] listOf1 gen = sized $ \n ->-  do k <- choose (1,1 `max` n)+  do k <- chooseInt (1,1 `max` n)      vectorOf k gen  -- | Generates a list of the given length.

@@ -780,7 +780,7 @@         timeoutResult       return (MkRose res' (map f roses)) -    timeoutResult = failed { reason = "Timeout" }+    timeoutResult = failed { reason = "Timeout of " ++ show n ++ " microseconds exceeded." } #ifdef NO_TIMEOUT     timeout _ = fmap Just #endif

@@ -1,3 +1,46 @@+QuickCheck 2.14 (release 2020-03-28)+	* QuickCheck is now much faster at generating test data!+	  As a result, many properties can now be tested a lot faster;+	  the examples distributed with QuickCheck run about twice as+	  fast as before, for example. Of course, your mileage may vary.++	  The reason for this is that there are now specialised versions+	  of the 'choose' combinator for various types. These are:+	  chooseInt, chooseInteger, chooseBoundedIntegral, and chooseEnum.+	  These combinators are identical to 'choose' but much faster.+	  All QuickCheck combinators, with the exception of 'choose'+	  itself, use the new combinators behind the scenes.++	  You should see a speedup without doing anything, but to get a+	  further speedup, consider replacing any uses of 'choose' in your+	  own generators with the new combinators.++	  We are hoping that future releases of the 'random' library may+	  speed up 'choose', in which case these combinators may no longer+	  be needed.++	  Thanks to Oleg Grenrus for suggesting to bypass 'choose' for+	  random number generation, and providing the appropriate+	  primitive in his 'splitmix' random number library.++	* Smaller changes and bugfixes:+		- RecursivelyShrink and GSubterms are exported from+		  Test.QuickCheck.Test (thanks to Tom Mortiboy).+		- Don't generate invalid unicode characters+		  (thanks to Boris Stepanov).+		- When a call to 'within' fails, include the duration of the+		  timeout in the failure report (thanks to William Rusnack).+		- In Gen, avoid splitting the seed in the implementation of+		  >>, *> and <- (thanks to David Feuer).+		- Fix a couple of bugs with shrinking of floating-point+		  numbers.+		- Export functionMapWith, functionEitherWith and+		  functionPairWith from Test.QuickCheck.Function+		  (thanks to Oleg Grenrus).+		- Remove redundant RealFloat constraint from+		  Arbitrary/CoArbitrary instances for Complex+		  (thanks to Bodigrim).+ QuickCheck 2.13.2 (released 2019-06-30) 	* Compatibility with GHC 8.8 (thanks to Bodigrim) 	* Improve error message when 'frequency' is used with only zero weights

@@ -9,7 +9,7 @@     -DNO_CTYPES_CONSTRUCTORS -DNO_FOREIGN_C_USECONDS -DNO_GENERICS \     -DNO_SAFE_HASKELL -DNO_POLYKINDS -DNO_MONADFAIL -DNO_TIMEOUT \     -DNO_NEWTYPE_DERIVING -DNO_TYPEABLE -DNO_GADTS -DNO_TRANSFORMERS \-    -DNO_DEEPSEQ \+    -DNO_DEEPSEQ -DNO_EXTRA_METHODS_IN_APPLICATIVE \     $i > quickcheck-hugs/$i done 

@@ -182,6 +182,16 @@ prop_no_shrinking_loop_Version = noShrinkingLoop :: Path Version -> Bool prop_no_shrinking_loop_ExitCode = noShrinkingLoop :: Path ExitCode -> Bool +-- Check that shrinking a Double always produces a shrinking candidate.+prop_shrink_candidate_double :: Property+prop_shrink_candidate_double =+  forAllShrink gen shrink $ \x ->+    x > 0 ==>+    not (null (shrink x))+  where+    gen :: Gen Double+    gen = oneof [arbitrary, fmap fromInteger arbitrary]+ -- Bad shrink: infinite list -- -- remove unexpectedFailure in prop_B1, shrinking should not loop forever.