QuickCheck 2.12.6.1 → 2.13

raw patch · 17 files changed

+359/−157 lines, 17 filesdep +splitmixdep −erfdep −tf-randomdep ~basedep ~deepseqPVP ok

version bump matches the API change (PVP)

Dependencies added: splitmix

Dependencies removed: erf, tf-random

Dependency ranges changed: base, deepseq

API changes (from Hackage documentation)

Files

• LICENSE +2/−2
• QuickCheck.cabal +23/−16
• README +3/−0
• Test/QuickCheck.hs +7/−1
• Test/QuickCheck/Exception.hs +4/−2
• Test/QuickCheck/Features.hs +1/−1
• Test/QuickCheck/Function.hs +1/−1
• Test/QuickCheck/Gen.hs +5/−3
• Test/QuickCheck/Modifiers.hs +43/−22
• Test/QuickCheck/Property.hs +36/−3
• Test/QuickCheck/Random.hs +55/−74
• Test/QuickCheck/Test.hs +90/−15
• Test/QuickCheck/Text.hs +2/−2
• changelog +20/−0
• make-hugs +18/−0
• tests/Generators.hs +21/−15
• tests/Split.hs +28/−0

@@ -1,8 +1,8 @@ (The following is the 3-clause BSD license.) -Copyright (c) 2000-2018, Koen Claessen+Copyright (c) 2000-2019, Koen Claessen Copyright (c) 2006-2008, Björn Bringert-Copyright (c) 2009-2018, Nick Smallbone+Copyright (c) 2009-2019, Nick Smallbone  Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:

@@ -1,10 +1,10 @@ Name: QuickCheck-Version: 2.12.6.1+Version: 2.13 Cabal-Version: >= 1.8 Build-type: Simple License: BSD3 License-file: LICENSE-Copyright: 2000-2018 Koen Claessen, 2006-2008 Björn Bringert, 2009-2018 Nick Smallbone+Copyright: 2000-2019 Koen Claessen, 2006-2008 Björn Bringert, 2009-2019 Nick Smallbone Author: Koen Claessen <koen@chalmers.se> Maintainer: Nick Smallbone <nick@smallbone.se> Bug-reports: https://github.com/nick8325/quickcheck/issues@@ -33,7 +33,7 @@   * <https://begriffs.com/posts/2017-01-14-design-use-quickcheck.html>,     a detailed tutorial written by a user of QuickCheck.   .-  The <http://hackage.haskell.org/package/quickcheck-instances quickcheck-instances>+  The <https://hackage.haskell.org/package/quickcheck-instances quickcheck-instances>   companion package provides instances for types in Haskell Platform packages   at the cost of additional dependencies. @@ -47,6 +47,7 @@   examples/Merge.hs   examples/Set.hs   examples/Simple.hs+  make-hugs  source-repository head   type:     git@@ -55,14 +56,14 @@ source-repository this   type:     git   location: https://github.com/nick8325/quickcheck-  tag:      2.12.6.1+  tag:      2.13  flag templateHaskell   Description: Build Test.QuickCheck.All, which uses Template Haskell.   Default: True  library-  Build-depends: base >=4.3 && <5, random, containers, erf >= 2+  Build-depends: base >=4.3 && <5, random, containers    -- Modules that are always built.   Exposed-Modules:@@ -84,7 +85,7 @@   -- GHC-specific modules.   if impl(ghc)     Exposed-Modules: Test.QuickCheck.Function-    Build-depends: transformers >= 0.3, deepseq+    Build-depends: transformers >= 0.3, deepseq >= 1.1.0.0   else     cpp-options: -DNO_TRANSFORMERS -DNO_DEEPSEQ @@ -109,11 +110,11 @@   if impl (ghc < 7.4)     cpp-options: -DNO_SAFE_HASKELL -  -- Use tf-random on newer GHCs.-  if impl(ghc)-    Build-depends: tf-random >= 0.4+  -- Use splitmix on newer GHCs.+  if impl(ghc >= 7.0)+    Build-depends: splitmix >= 0.0.2   else-    cpp-options: -DNO_TF_RANDOM+    cpp-options: -DNO_SPLITMIX    if !impl(ghc >= 7.6)       cpp-options: -DNO_POLYKINDS@@ -125,7 +126,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+    cpp-options: -DNO_TIMEOUT -DNO_NEWTYPE_DERIVING -DNO_GENERICS -DNO_TEMPLATE_HASKELL -DNO_SAFE_HASKELL -DNO_TYPEABLE -DNO_GADTS     if !impl(hugs) && !impl(uhc)       cpp-options: -DNO_ST_MONAD -DNO_MULTI_PARAM_TYPE_CLASSES @@ -154,7 +155,7 @@     hs-source-dirs: tests     main-is: GCoArbitraryExample.hs     build-depends: base, QuickCheck-    if !impl(ghc >= 7.2)+    if !flag(templateHaskell) || !impl(ghc >= 7.2)         buildable: False     if impl(ghc >= 7.2) && impl(ghc < 7.6)         build-depends: ghc-prim@@ -172,7 +173,7 @@     hs-source-dirs: tests     main-is: GShrinkExample.hs     build-depends: base, QuickCheck-    if !impl(ghc >= 7.2)+    if !flag(templateHaskell) || !impl(ghc >= 7.2)         buildable: False     if impl(ghc >= 7.2) && impl(ghc < 7.6)         build-depends: ghc-prim@@ -181,8 +182,8 @@     type: exitcode-stdio-1.0     hs-source-dirs: tests     main-is: Terminal.hs-    build-depends: base, process, deepseq, QuickCheck-    if !impl(ghc >= 7.10)+    build-depends: base, process, deepseq >= 1.1.0.0, QuickCheck+    if !flag(templateHaskell) || !impl(ghc >= 7.10)         buildable: False  Test-Suite test-quickcheck-monadfix@@ -190,5 +191,11 @@     hs-source-dirs: tests     main-is: MonadFix.hs     build-depends: base, QuickCheck-    if !impl(ghc >= 7.10)+    if !flag(templateHaskell) || !impl(ghc >= 7.10)         buildable: False++Test-Suite test-quickcheck-split+    type: exitcode-stdio-1.0+    hs-source-dirs: tests+    main-is: Split.hs+    build-depends: base, QuickCheck

@@ -8,3 +8,6 @@ Haskell Platform packages at the cost of additional dependencies.  [1]: http://hackage.haskell.org/package/quickcheck-instances++The make-hugs scripts makes a Hugs-compatible version of QuickCheck.+It may also be useful for other non-GHC implementations.

@@ -136,6 +136,7 @@   , sample   , sample' +#ifndef NO_GADTS     -- * The 'Function' typeclass: generation of random shrinkable, showable functions      -- | Example of use:@@ -145,7 +146,7 @@     -- >>>     prop (Fun _ f) = f "monkey" == f "banana" || f "banana" == f "elephant"     -- >>> :}     -- >>> quickCheck prop-    -- *** Failed! Falsifiable (after 3 tests and 134 shrinks):+    -- *** Failed! Falsified (after 3 tests and 134 shrinks):     -- {"elephant"->1, "monkey"->1, _->0}     --     -- To generate random values of type @'Fun' a b@,@@ -170,6 +171,7 @@   , functionIntegral   , functionRealFrac   , functionBoundedEnum+#endif      -- * The 'CoArbitrary' typeclass: generation of functions the old-fashioned way   , CoArbitrary(..)@@ -220,8 +222,10 @@   , InfiniteList(..)   , SortedList(..)   , Positive(..)+  , Negative(..)   , NonZero(..)   , NonNegative(..)+  , NonPositive(..)   , Large(..)   , Small(..)   , Smart(..)@@ -303,7 +307,9 @@ import Test.QuickCheck.Property hiding ( Result(..) ) import Test.QuickCheck.Test import Test.QuickCheck.Exception+#ifndef NO_GADTS import Test.QuickCheck.Function+#endif import Test.QuickCheck.Features import Test.QuickCheck.State #ifndef NO_TEMPLATE_HASKELL

@@ -59,15 +59,17 @@ tryEvaluateIO :: IO a -> IO (Either AnException a) tryEvaluateIO m = E.tryJust notAsync (m >>= E.evaluate)   where-    notAsync :: E.SomeException -> Maybe AnException+    notAsync :: AnException -> Maybe AnException #if MIN_VERSION_base(4,7,0)     notAsync e = case E.fromException e of         Just (E.SomeAsyncException _) -> Nothing         Nothing                       -> Just e-#else+#elif !defined(OLD_EXCEPTIONS)     notAsync e = case E.fromException e :: Maybe E.AsyncException of         Just _  -> Nothing         Nothing -> Just e+#else+    notAsync e = Just e #endif  --tryEvaluateIO m = Right `fmap` m

@@ -92,7 +92,7 @@           Failure{reason = "New feature found"} -> do             putLine (terminal state) $               "*** Found example of " ++-              intercalate ", " (Set.toList (feats' Set.\\ feats))+              concat (intersperse ", " (Set.toList (feats' Set.\\ feats)))             mapM_ (putLine (terminal state)) (failingTestCase res)             putStrLn ""             loop (Set.union feats feats')

@@ -27,7 +27,7 @@ -- >>>     prop (Fun _ f) = f "monkey" == f "banana" || f "banana" == f "elephant" -- >>> :} -- >>> quickCheck prop--- *** Failed! Falsifiable (after 3 tests and 134 shrinks):+-- *** Failed! Falsified (after 3 tests and 134 shrinks): -- {"elephant"->1, "monkey"->1, _->0} -- -- To generate random values of type @'Fun' a b@,

@@ -41,9 +41,11 @@  -- | A generator for values of type @a@. ----- The third-party package+-- The third-party packages -- <http://hackage.haskell.org/package/QuickCheck-GenT QuickCheck-GenT>--- provides a monad transformer version of @GenT@.+-- and+-- <http://hackage.haskell.org/package/quickcheck-transformer quickcheck-transformer>+-- provide monad transformer versions of @Gen@. newtype Gen a = MkGen{   unGen :: QCGen -> Int -> a -- ^ Run the generator on a particular seed.                              -- If you just want to get a random value out, consider using 'generate'.@@ -80,7 +82,7 @@  -- | Modifies a generator using an integer seed. variant :: Integral n => n -> Gen a -> Gen a-variant k (MkGen g) = MkGen (\r n -> g (variantQCGen k r) n)+variant k (MkGen g) = MkGen (\r n -> g (integerVariant (toInteger k) $! r) n)  -- | Used to construct generators that depend on the size parameter. --

@@ -54,8 +54,10 @@   , InfiniteList(..)   , SortedList(..)   , Positive(..)+  , Negative(..)   , NonZero(..)   , NonNegative(..)+  , NonPositive(..)   , Large(..)   , Small(..)   , Smart(..)@@ -186,7 +188,7 @@ -- the remaining (infinite) part can contain anything: -- -- >>> quickCheck prop_take_10--- *** Failed! Falsifiable (after 1 test and 14 shrinks):+-- *** Failed! Falsified (after 1 test and 14 shrinks): -- "bbbbbbbbbb" ++ ... data InfiniteList a =   InfiniteList {@@ -262,16 +264,28 @@   fmap f (Positive x) = Positive (f x)  instance (Num a, Ord a, Arbitrary a) => Arbitrary (Positive a) where-  arbitrary =-    ((Positive . abs) `fmap` (arbitrary `suchThat` (/= 0))) `suchThat` gt0-    where gt0 (Positive x) = x > 0+  arbitrary = fmap Positive (fmap abs arbitrary `suchThat` (> 0))+  shrink (Positive x) = [ Positive x' | x' <- shrink x , x' > 0 ] -  shrink (Positive x) =-    [ Positive x'-    | x' <- shrink x-    , x' > 0-    ]+--------------------------------------------------------------------------+-- | @Negative x@: guarantees that @x \< 0@.+newtype Negative a = Negative {getNegative :: a}+ deriving ( Eq, Ord, Show, Read+#ifndef NO_NEWTYPE_DERIVING+          , Enum+#endif+#ifndef NO_TYPEABLE+          , Typeable+#endif+          ) +instance Functor Negative where+  fmap f (Negative x) = Negative (f x)++instance (Num a, Ord a, Arbitrary a) => Arbitrary (Negative a) where+  arbitrary = fmap Negative (arbitrary `suchThat` (< 0))+  shrink (Negative x) = [ Negative x' | x' <- shrink x , x' < 0 ]+ -------------------------------------------------------------------------- -- | @NonZero x@: guarantees that @x \/= 0@. newtype NonZero a = NonZero {getNonZero :: a}@@ -308,20 +322,27 @@   fmap f (NonNegative x) = NonNegative (f x)  instance (Num a, Ord a, Arbitrary a) => Arbitrary (NonNegative a) where-  arbitrary =-    (frequency-       -- why is this distrbution like this?-       [ (5, (NonNegative . abs) `fmap` arbitrary)-       , (1, return (NonNegative 0))-       ]-    ) `suchThat` ge0-    where ge0 (NonNegative x) = x >= 0+  arbitrary = fmap NonNegative (fmap abs arbitrary `suchThat` (>= 0))+  shrink (NonNegative x) = [ NonNegative x' | x' <- shrink x , x' >= 0 ] -  shrink (NonNegative x) =-    [ NonNegative x'-    | x' <- shrink x-    , x' >= 0-    ]+--------------------------------------------------------------------------+-- | @NonPositive x@: guarantees that @x \<= 0@.+newtype NonPositive a = NonPositive {getNonPositive :: a}+ deriving ( Eq, Ord, Show, Read+#ifndef NO_NEWTYPE_DERIVING+          , Enum+#endif+#ifndef NO_TYPEABLE+          , Typeable+#endif+          )++instance Functor NonPositive where+  fmap f (NonPositive x) = NonPositive (f x)++instance (Num a, Ord a, Arbitrary a) => Arbitrary (NonPositive a) where+  arbitrary = fmap NonPositive (arbitrary `suchThat` (<= 0))+  shrink (NonPositive x) = [ NonPositive x' | x' <- shrink x , x' <= 0 ]  -------------------------------------------------------------------------- -- | @Large x@: by default, QuickCheck generates 'Int's drawn from a small

@@ -94,6 +94,15 @@   -- | Convert the thing to a property.   property :: prop -> Property +  -- | Optional; used internally in order to improve shrinking.+  -- @propertyForAll gen shr shw f@ is normally equivalent to+  -- @'forAllShrinkShow' gen shr shw f@.+  -- The 'Testable' instance for functions defines+  -- @propertyForAll@ in a way that improves shrinking.+  propertyForAllShrinkShow :: Show a => Gen a -> (a -> [a]) -> (a -> String) -> (a -> prop) -> Property+  propertyForAllShrinkShow gen shr f =+    forAllShrinkShow gen shr f+ -- | If a property returns 'Discard', the current test case is discarded, -- the same as if a precondition was false. --@@ -115,6 +124,13 @@       -- so that we turn exceptions into test failures       liftUnit () = succeeded +instance Testable prop => Testable (Maybe prop) where+  property = property . liftMaybe+    where+      -- See comment for liftUnit above+      liftMaybe Nothing = property Discard+      liftMaybe (Just prop) = property prop+ instance Testable Bool where   property = property . liftBool @@ -157,7 +173,16 @@   promote . fmap (unProperty . property)  instance (Arbitrary a, Show a, Testable prop) => Testable (a -> prop) where-  property f = forAllShrink arbitrary shrink f+  property f =+    propertyForAllShrinkShow arbitrary shrink show f+  propertyForAllShrinkShow gen shr shw f =+    -- gen :: Gen b, shr :: b -> [b], f :: b -> a -> prop+    -- Idea: Generate and shrink (b, a) as a pair+    propertyForAllShrinkShow+      (liftM2 (,) gen arbitrary)+      (liftShrink2 shr shrink)+      (\(x, y) -> shw x ++ "\n" ++ show y)+      (uncurry f)  -- ** Exception handling protect :: (AnException -> a) -> IO a -> IO a@@ -305,7 +330,7 @@  liftBool :: Bool -> Result liftBool True = succeeded-liftBool False = failed { reason = "Falsifiable" }+liftBool False = failed { reason = "Falsified" }  mapResult :: Testable prop => (Result -> Result) -> prop -> Property mapResult f = mapRoseResult (protectResults . fmap f)@@ -505,7 +530,9 @@ -- not what you want, use 'tabulate'. label :: Testable prop => String -> prop -> Property label s =+#ifndef NO_DEEPSEQ   s `deepseq`+#endif   mapTotalResult $     \res -> res { labels = s:labels res } @@ -553,7 +580,9 @@          -> prop -> Property classify False _ = property classify True s =+#ifndef NO_DEEPSEQ   s `deepseq`+#endif   mapTotalResult $     \res -> res { classes = s:classes res } @@ -654,7 +683,9 @@ -- 16% LogOut tabulate :: Testable prop => String -> [String] -> prop -> Property tabulate key values =+#ifndef NO_DEEPSEQ   key `deepseq` values `deepseq`+#endif   mapTotalResult $     \res -> res { tables = [(key, value) | value <- values] ++ tables res } @@ -704,7 +735,9 @@ coverTable :: Testable prop =>   String -> [(String, Double)] -> prop -> Property coverTable table xs =-  tables `deepseq` xs `deepseq`+#ifndef NO_DEEPSEQ+  table `deepseq` xs `deepseq`+#endif   mapTotalResult $     \res -> res { requiredCoverage = ys ++ requiredCoverage res }   where

@@ -6,65 +6,23 @@ #endif module Test.QuickCheck.Random where -#ifndef NO_TF_RANDOM import System.Random-import System.Random.TF-import System.Random.TF.Gen(splitn)-import Data.Word-import Data.Bits--#define TheGen TFGen--newTheGen :: IO TFGen-newTheGen = newTFGen--bits, mask, doneBit :: Integral a => a-bits = 14-mask = 0x3fff-doneBit = 0x4000--chip :: Bool -> Word32 -> TFGen -> TFGen-chip done n g = splitn g (bits+1) (if done then m .|. doneBit else m)-  where-    m = n .&. mask--chop :: Integer -> Integer-chop n = n `shiftR` bits--stop :: Integral a => a -> Bool-stop n = n <= mask--mkTheGen :: Int -> TFGen-mkTheGen = mkTFGen--#else-import System.Random--#define TheGen StdGen--newTheGen :: IO StdGen-newTheGen = newStdGen--mkTheGen :: Int -> StdGen-mkTheGen = mkStdGen--chip :: Bool -> Int -> StdGen -> StdGen-chip finished n = boolVariant finished . boolVariant (even n)--chop :: Integer -> Integer-chop n = n `div` 2--stop :: Integral a => a -> Bool-stop n = n <= 1+#ifndef NO_SPLITMIX+import System.Random.SplitMix #endif+import Data.Bits  -- | The "standard" QuickCheck random number generator.--- A wrapper around either 'TFGen' on GHC, or 'StdGen'+-- A wrapper around either 'SMGen' on GHC, or 'StdGen' -- on other Haskell systems.-newtype QCGen = QCGen TheGen+#ifdef NO_SPLITMIX+newtype QCGen = QCGen StdGen+#else+newtype QCGen = QCGen SMGen+#endif  instance Show QCGen where-  showsPrec n (QCGen g) s = showsPrec n g "" ++ s+  showsPrec n (QCGen g) s = showsPrec n g s instance Read QCGen where   readsPrec n xs = [(QCGen g, ys) | (g, ys) <- readsPrec n xs] @@ -78,32 +36,55 @@       (x, g') -> (x, QCGen g')  newQCGen :: IO QCGen-newQCGen = fmap QCGen newTheGen+#ifdef NO_SPLITMIX+newQCGen = fmap QCGen newStdGen+#else+newQCGen = fmap QCGen newSMGen+#endif  mkQCGen :: Int -> QCGen-mkQCGen n = QCGen (mkTheGen n)+#ifdef NO_SPLITMIX+mkQCGen n = QCGen (mkStdGen n)+#else+mkQCGen n = QCGen (mkSMGen (fromIntegral n))+#endif -bigNatVariant :: Integer -> TheGen -> TheGen-bigNatVariant n g-  | g `seq` stop n = chip True (fromInteger n) g-  | otherwise      = (bigNatVariant $! chop n) $! chip False (fromInteger n) g+-- Parameterised in order to make this code testable.+class Splittable a where+  left, right :: a -> a -{-# INLINE natVariant #-}-natVariant :: Integral a => a -> TheGen -> TheGen-natVariant n g-  | g `seq` stop n = chip True (fromIntegral n) g-  | otherwise      = bigNatVariant (toInteger n) g+instance Splittable QCGen where+  left = fst . split+  right = snd . split -{-# INLINE variantTheGen #-}-variantTheGen :: Integral a => a -> TheGen -> TheGen-variantTheGen n g-  | n >= 1    = natVariant (n-1) (boolVariant False g)-  | n == 0   = natVariant (0 `asTypeOf` n) (boolVariant True g)-  | otherwise = bigNatVariant (negate (toInteger n)) (boolVariant True g)+-- The logic behind 'variant'. Given a random number seed, and an integer, uses+-- splitting to transform the seed according to the integer. We use a+-- prefix-free code so that calls to integerVariant n g for different values of+-- n are guaranteed to return independent seeds.+{-# INLINE integerVariant #-}+integerVariant :: Splittable a => Integer -> a -> a+integerVariant n g+  -- Use one bit to encode the sign, then use Elias gamma coding+  -- (https://en.wikipedia.org/wiki/Elias_gamma_coding) to do the rest.+  -- Actually, the first bit encodes whether n >= 1 or not;+  -- this has the advantage that both 0 and 1 get short codes.+  | n >= 1 = gamma n $! left g+  | otherwise = gamma (1-n) $! right g+  where+    gamma n =+      encode k . zeroes k+      where+        k = ilog2 n -boolVariant :: Bool -> TheGen -> TheGen-boolVariant False = fst . split-boolVariant True = snd . split+        encode (-1) g = g+        encode k g+          | testBit n k =+            encode (k-1) $! right g+          | otherwise =+            encode (k-1) $! left g -variantQCGen :: Integral a => a -> QCGen -> QCGen-variantQCGen n (QCGen g) = QCGen (variantTheGen n g)+        zeroes 0 g = g+        zeroes k g = zeroes (k-1) $! left g++    ilog2 1 = 0+    ilog2 n = 1 + ilog2 (n `div` 2)

@@ -1,6 +1,9 @@ {-# OPTIONS_HADDOCK hide #-} -- | The main test loop. {-# LANGUAGE CPP #-}+#ifndef NO_TYPEABLE+{-# LANGUAGE DeriveDataTypeable #-}+#endif #ifndef NO_SAFE_HASKELL {-# LANGUAGE Trustworthy #-} #endif@@ -17,7 +20,6 @@ import qualified Test.QuickCheck.State as S import Test.QuickCheck.Exception import Test.QuickCheck.Random-import Data.Number.Erf(invnormcdf) import System.Random(split) #if defined(MIN_VERSION_containers) #if MIN_VERSION_containers(0,5,0)@@ -41,16 +43,18 @@   , sortBy   , group   , intersperse-  , intercalate   )  import Data.Maybe(fromMaybe, isNothing, catMaybes) import Data.Ord(comparing) import Text.Printf(printf)-import Data.Either(lefts, rights) import Control.Monad import Data.Bits +#ifndef NO_TYPEABLE+import Data.Typeable (Typeable)+#endif+ -------------------------------------------------------------------------- -- quickCheck @@ -79,7 +83,11 @@     -- ^ Maximum number of shrinks to before giving up. Setting this to zero     --   turns shrinking off.   }- deriving ( Show, Read )+ deriving ( Show, Read+#ifndef NO_TYPEABLE+  , Typeable+#endif+  )  -- | Result represents the test result data Result@@ -167,6 +175,12 @@ -- -- By default up to 100 tests are performed, which may not be enough -- to find all bugs. To run more tests, use 'withMaxSuccess'.+--+-- If you want to get the counterexample as a Haskell value,+-- rather than just printing it, try the+-- <http://hackage.haskell.org/package/quickcheck-with-counterexamples quickcheck-with-counterexamples>+-- package.+ quickCheck :: Testable prop => prop -> IO () quickCheck p = quickCheckWith stdArgs p @@ -390,16 +404,16 @@   where     summary =       header ++-      short 26 (oneLine reason ++ " ") +++      short 26 (oneLine theReason ++ " ") ++       count True ++ "..."      full =       (header ++-       (if isOneLine reason then reason ++ " " else "") +++       (if isOneLine theReason then theReason ++ " " else "") ++        count False ++ ":"):-      if isOneLine reason then [] else lines reason+      if isOneLine theReason then [] else lines theReason -    reason = P.reason res+    theReason = P.reason res      header =       if expect res then@@ -433,10 +447,10 @@           (":":short, long)  labelsAndTables :: State -> ([String], [String])-labelsAndTables st = (labels, tables)+labelsAndTables st = (theLabels, theTables)   where-    labels :: [String]-    labels =+    theLabels :: [String]+    theLabels =       paragraphs $         [ showTable (numSuccessTests st) Nothing m         | m <- S.classes st:Map.elems numberedLabels ]@@ -448,8 +462,8 @@         | (labels, n) <- Map.toList (S.labels st),           (i, l) <- zip [0..] labels ] -    tables :: [String]-    tables =+    theTables :: [String]+    theTables =       paragraphs $         [ showTable (sum (Map.elems m)) (Just table) m         | (table, m) <- Map.toList (S.tables st) ] ++@@ -573,6 +587,67 @@ wilsonHigh :: Integer -> Integer -> Double -> Double wilsonHigh k n a = wilson k n (invnormcdf (1-a/2)) +-- Algorithm taken from+-- https://web.archive.org/web/20151110174102/http://home.online.no/~pjacklam/notes/invnorm/+-- Accurate to about one part in 10^9.+--+-- The 'erf' package uses the same algorithm, but with an extra step+-- to get a fully accurate result, which we skip because it requires+-- the 'erfc' function.+invnormcdf :: Double -> Double+invnormcdf p+  | p < 0  = 0/0+  | p > 1  = 0/0+  | p == 0 = -1/0+  | p == 1 = 1/0+  | p < p_low =+    let+      q = sqrt(-2*log(p))+    in+      (((((c1*q+c2)*q+c3)*q+c4)*q+c5)*q+c6) /+      ((((d1*q+d2)*q+d3)*q+d4)*q+1)+  | p <= p_high =+    let+      q = p - 0.5+      r = q*q+    in+      (((((a1*r+a2)*r+a3)*r+a4)*r+a5)*r+a6)*q /+      (((((b1*r+b2)*r+b3)*r+b4)*r+b5)*r+1)+  | otherwise =+    let+      q = sqrt(-2*log(1-p))+    in+      -(((((c1*q+c2)*q+c3)*q+c4)*q+c5)*q+c6) /+       ((((d1*q+d2)*q+d3)*q+d4)*q+1)+  where+    a1 = -3.969683028665376e+01+    a2 =  2.209460984245205e+02+    a3 = -2.759285104469687e+02+    a4 =  1.383577518672690e+02+    a5 = -3.066479806614716e+01+    a6 =  2.506628277459239e+00++    b1 = -5.447609879822406e+01+    b2 =  1.615858368580409e+02+    b3 = -1.556989798598866e+02+    b4 =  6.680131188771972e+01+    b5 = -1.328068155288572e+01++    c1 = -7.784894002430293e-03+    c2 = -3.223964580411365e-01+    c3 = -2.400758277161838e+00+    c4 = -2.549732539343734e+00+    c5 =  4.374664141464968e+00+    c6 =  2.938163982698783e+00++    d1 =  7.784695709041462e-03+    d2 =  3.224671290700398e-01+    d3 =  2.445134137142996e+00+    d4 =  3.754408661907416e+00++    p_low  = 0.02425+    p_high = 1 - p_low+ addCoverageCheck :: Confidence -> State -> Property -> Property addCoverageCheck confidence st prop   | and [ sufficientlyCovered confidence tot n p@@ -581,9 +656,9 @@     once prop   | or [ insufficientlyCovered (Just (certainty confidence)) tot n p        | (_, _, tot, n, p) <- allCoverage st ] =-    let (labels, tables) = labelsAndTables st in+    let (theLabels, theTables) = labelsAndTables st in     foldr counterexample (property failed{P.reason = "Insufficient coverage"})-      (paragraphs [labels, tables])+      (paragraphs [theLabels, theTables])   | otherwise = prop  allCoverage :: State -> [(Maybe String, String, Int, Int, Double)]

@@ -125,7 +125,7 @@     cols = transpose rows     widths = map (maximum . map (length . text)) cols -    row cells = intercalate " " (zipWith cell widths cells)+    row cells = concat (intersperse " " (zipWith cell widths cells))     cell n (LJust xs) = ljust n xs     cell n (RJust xs) = rjust n xs     cell n (Centred xs) = centre n xs@@ -149,7 +149,7 @@     border x y xs = [x, y] ++ centre width xs ++ [y, x]  paragraphs :: [[String]] -> [String]-paragraphs = intercalate [""] . filter (not . null)+paragraphs = concat . intersperse [""] . filter (not . null)  bold :: String -> String -- not portable:

@@ -1,3 +1,23 @@+QuickCheck 2.13 (released 2019-03-26)+	* Properties with multiple arguments now shrink better.+	  Previously, the first argument was shrunk, then the second, and+	  so on. Now, the arguments are shrunk as a whole, so shrink steps+	  for different arguments can be interleaved.++	* New features:+		- New modifiers Negative and NonPositive+		- A Testable instance for Maybe prop (where Nothing means 'discard+		  the test case')+	* Dependencies on C code removed:+		- Use splitmix instead of tf-random for random number generation+		- Remove dependency on 'erf' package+	* Small changes:+		- Say 'Falsified' instead of 'Falsifiable' when a property fails+	* Compatibility improvements:+		- Explicitly derive instance Typeable Args+		- Lower bound on deepseq+		- A script for building Hugs packages+ QuickCheck 2.12.6 (released 2018-10-02) 	* Make arbitrarySizedBoundedIntegral handle huge sizes correctly. 	* Add changelog for QuickCheck 2.12.5 :)

@@ -0,0 +1,18 @@+#!/bin/bash+cd $(dirname $0)+for i in $(find Test -name '*.hs'); do+  mkdir -p quickcheck-hugs/$(dirname $i)+  # If you want to switch on and off other features, look in+  # QuickCheck.cabal to see what's available, or submit a patch+  # adding a new -DNO_... flag.+  cpphs --noline -DNO_SPLITMIX -DNO_TEMPLATE_HASKELL \+    -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 \+    $i > quickcheck-hugs/$i+done++echo "A Hugs-compatible version of QuickCheck is now"+echo "available in the quickcheck-hugs directory."+echo "Load it with hugs -98."

@@ -105,8 +105,8 @@    Arbitrary (f (Extremal Word16)), Show (f (Extremal Word16)),    Arbitrary (f (Extremal Word32)), Show (f (Extremal Word32)),    Arbitrary (f (Extremal Word64)), Show (f (Extremal Word64))) =>-  (forall a. f a -> a) -> (forall a. Integral a => a -> Bool) -> Property-pathInt f p =+  Bool -> (forall a. f a -> a) -> (forall a. Integral a => a -> Bool) -> Property+pathInt word f p =   conjoin     [counterexample "Int" (path ((p :: Int -> Bool) . getExtremal . f)),      counterexample "Integer" (path ((p :: Integer -> Bool) . f)),@@ -114,22 +114,28 @@      counterexample "Int16" (path ((p :: Int16 -> Bool) . getExtremal . f)),      counterexample "Int32" (path ((p :: Int32 -> Bool) . getExtremal . f)),      counterexample "Int64" (path ((p :: Int64 -> Bool) . getExtremal . f)),-     counterexample "Word" (path ((p :: Word -> Bool) . getExtremal . f)),-     counterexample "Word8" (path ((p :: Word8 -> Bool) . getExtremal . f)),-     counterexample "Word16" (path ((p :: Word16 -> Bool) . getExtremal . f)),-     counterexample "Word32" (path ((p :: Word32 -> Bool) . getExtremal . f)),-     counterexample "Word64" (path ((p :: Word64 -> Bool) . getExtremal . f))]-somePathInt f p = expectFailure (pathInt f (not . p))+     counterexample "Word" (not word .||. path ((p :: Word -> Bool) . getExtremal . f)),+     counterexample "Word8" (not word .||. path ((p :: Word8 -> Bool) . getExtremal . f)),+     counterexample "Word16" (not word .||. path ((p :: Word16 -> Bool) . getExtremal . f)),+     counterexample "Word32" (not word .||. path ((p :: Word32 -> Bool) . getExtremal . f)),+     counterexample "Word64" (not word .||. path ((p :: Word64 -> Bool) . getExtremal . f))]+somePathInt word f p = expectFailure (pathInt word f (not . p)) -prop_positive = pathInt getPositive (> 0)-prop_positive_bound = somePathInt getPositive (== 1)+prop_positive = pathInt True getPositive (> 0)+prop_positive_bound = somePathInt True getPositive (== 1) -prop_nonzero = pathInt getNonZero (/= 0)-prop_nonzero_bound_1 = somePathInt getNonZero (== 1)-prop_nonzero_bound_2 = somePathInt getNonZero (== -1)+prop_nonzero = pathInt True getNonZero (/= 0)+prop_nonzero_bound_1 = somePathInt True getNonZero (== 1)+prop_nonzero_bound_2 = somePathInt True getNonZero (== -1) -prop_nonnegative = pathInt getNonNegative (>= 0)-prop_nonnegative_bound = somePathInt getNonNegative (== 0)+prop_nonnegative = pathInt True getNonNegative (>= 0)+prop_nonnegative_bound = somePathInt True getNonNegative (== 0)++prop_negative = pathInt False getNegative (< 0)+prop_negative_bound = somePathInt False getNegative (== -1)++prop_nonpositive = pathInt True getNonPositive (<= 0)+prop_nonpositive_bound = somePathInt True getNonPositive (== 0)  reachesBound :: (Bounded a, Integral a, Arbitrary a) =>   a -> Property

@@ -0,0 +1,28 @@+import Test.QuickCheck+import Test.QuickCheck.Random+import Data.List++-- This type allows us to run integerVariant and get a list of bits out.+newtype Splits = Splits { unSplits :: [Bool] } deriving (Eq, Ord, Show)++instance Splittable Splits where+  left (Splits xs) = Splits (xs ++ [False])+  right (Splits xs) = Splits (xs ++ [True])++-- Check that integerVariant gives a prefix-free code,+-- i.e., if m /= n then integerVariant m is not a prefix of integerVariant n.+prop_split_prefix :: Property+prop_split_prefix =+  once $ forAllShrink (return [-10000..10000]) shrink $ \ns ->+    map head (group (sort ns)) == sort ns ==> -- no duplicates+    let+      codes :: [Splits]+      codes = sort [integerVariant n (Splits []) | n <- ns]++      ok (Splits xs) (Splits ys) = not (xs `isPrefixOf` ys)+    in+      -- After sorting, any prefix will end up immediately before+      -- one of its suffixes+      and (zipWith ok codes (drop 1 codes))++main = do Success{} <- quickCheckResult prop_split_prefix; return ()