QuickCheck 2.8.2 → 2.9

raw patch · 14 files changed

+714/−138 lines, 14 filesdep +natsdep +semigroupsdep −extensible-exceptionsdep −ghcdep ~QuickCheckdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: nats, semigroups

Dependencies removed: extensible-exceptions, ghc

Dependency ranges changed: QuickCheck, base

API changes (from Hackage documentation)

Files

• LICENSE +2/−2
• QuickCheck.cabal +53/−48
• Test/QuickCheck.hs +2/−1
• Test/QuickCheck/All.hs +3/−3
• Test/QuickCheck/Arbitrary.hs +224/−6
• Test/QuickCheck/Exception.hs +4/−37
• Test/QuickCheck/Function.hs +201/−22
• Test/QuickCheck/Property.hs +14/−9
• Test/QuickCheck/Random.hs +6/−6
• Test/QuickCheck/Test.hs +7/−4
• changelog +15/−0
• tests/GCoArbitraryExample.hs +20/−0
• tests/GShrinkExample.hs +17/−0
• tests/Generators.hs +146/−0

@@ -1,6 +1,6 @@-Copyright (c) 2000-2015, Koen Claessen+Copyright (c) 2000-2016, Koen Claessen Copyright (c) 2006-2008, Björn Bringert-Copyright (c) 2009-2015, Nick Smallbone+Copyright (c) 2009-2016, Nick Smallbone All rights reserved.  Redistribution and use in source and binary forms, with or without

@@ -1,15 +1,15 @@ Name: QuickCheck-Version: 2.8.2+Version: 2.9 Cabal-Version: >= 1.8 Build-type: Simple License: BSD3 License-file: LICENSE Extra-source-files: README changelog-Copyright: 2000-2015 Koen Claessen, 2006-2008 Björn Bringert, 2009-2015 Nick Smallbone+Copyright: 2000-2016 Koen Claessen, 2006-2008 Björn Bringert, 2009-2016 Nick Smallbone Author: Koen Claessen <koen@chalmers.se> Maintainer: QuickCheck developers <quickcheck@projects.haskell.org> Bug-reports: mailto:quickcheck@projects.haskell.org-Tested-with: GHC >=6.10, Hugs, UHC+Tested-with: GHC >= 7 Homepage: https://github.com/nick8325/quickcheck Category:       Testing Synopsis:       Automatic testing of Haskell programs@@ -37,36 +37,14 @@ source-repository this   type:     git   location: https://github.com/nick8325/quickcheck-  tag:      2.8.2--flag base3-  Description: Choose the new smaller, split-up base package.--flag base4-  Description: Choose the even newer base package with extensible exceptions.--flag base4point8-  Description: Choose the even more newer base package with natural numbers.+  tag:      2.9  flag templateHaskell   Description: Build Test.QuickCheck.All, which uses Template Haskell.   Default: True  library-  -- Choose which library versions to use.-  if flag(base4point8)-    Build-depends: base >= 4.8 && < 5-  else-    if flag(base4)-      Build-depends: base >= 4 && < 4.8-    else-      if flag(base3)-        Build-depends: base >= 3 && < 4-      else-        Build-depends: base < 3-  if flag(base4point8) || flag(base4) || flag(base3)-    Build-depends: random-  Build-depends: containers+  Build-depends: base >=4.3 && <5, random, containers    -- Modules that are always built.   Exposed-Modules:@@ -87,31 +65,18 @@   -- GHC-specific modules.   if impl(ghc)     Exposed-Modules: Test.QuickCheck.Function-  if impl(ghc >= 7)     Build-depends: transformers >= 0.2   else     cpp-options: -DNO_TRANSFORMERS-  if impl(ghc >= 6.12) && flag(templateHaskell)++  if impl(ghc) && flag(templateHaskell)+    -- && !impl(haste)     Build-depends: template-haskell >= 2.4     Other-Extensions: TemplateHaskell     Exposed-Modules: Test.QuickCheck.All   else     cpp-options: -DNO_TEMPLATE_HASKELL -  -- Compiler-specific tweaks, lots of 'em!--  -- On old versions of GHC use the ghc package to catch ctrl-C.-  if impl(ghc >= 6.7) && impl(ghc < 6.13)-      Build-depends: ghc--  -- We want to use extensible-exceptions even if linking against base-3.-  if impl(ghc >= 6.9) && impl (ghc < 7.0)-    Build-depends: extensible-exceptions--  -- GHC < 7.0 can't cope with multiple LANGUAGE pragmas in the same file.-  if impl(ghc < 7)-    Extensions: GeneralizedNewtypeDeriving, MultiParamTypeClasses, Rank2Types, TypeOperators-   -- The new generics appeared in GHC 7.2...   if impl(ghc < 7.2)     cpp-options: -DNO_GENERICS@@ -124,15 +89,26 @@     cpp-options: -DNO_SAFE_HASKELL    -- Use tf-random on newer GHCs.-  if impl(ghc >= 7) && (flag(base4point8) || flag(base4))+  if impl(ghc)+    -- && !impl(haste)     Build-depends: tf-random >= 0.4   else     cpp-options: -DNO_TF_RANDOM -  -- Natural numbers.-  if !flag(base4point8)-    cpp-options: -DNO_NATURALS+  if impl(ghc)+    if impl(ghc < 7.10)+      -- `Numeric.Natural` is available in base only since GHC 7.10 / base 4.8+      build-depends: nats>=1+  else+      cpp-options: -DNO_NATURALS +  if impl(ghc)+    -- 'Data.List.NonEmpty' is available in base only since GHC 8.0 / base 4.9+    if impl(ghc < 8.0)+      build-depends: semigroups >=0.9+  else+      cpp-options: -DNO_NONEMPTY+   -- Switch off most optional features on non-GHC systems.   if !impl(ghc)     -- If your Haskell compiler can cope without some of these, please@@ -160,11 +136,40 @@     build-depends:       base,       containers,-      QuickCheck == 2.8.2,+      QuickCheck == 2.9,       template-haskell >= 2.4,       test-framework >= 0.4 && < 0.9     if flag(templateHaskell)+        -- && !impl(haste)         Buildable: True     else         Buildable: False +Test-Suite test-quickcheck-gcoarbitrary+    type: exitcode-stdio-1.0+    hs-source-dirs: tests+    main-is: GCoArbitraryExample.hs+    build-depends: base, QuickCheck == 2.9+    if impl(ghc < 7.2)+        buildable: False+    if impl(ghc >= 7.2) && impl(ghc < 7.6)+        build-depends: ghc-prim++Test-Suite test-quickcheck-generators+    type: exitcode-stdio-1.0+    hs-source-dirs: tests+    main-is: Generators.hs+    build-depends: base, QuickCheck == 2.9+    if !flag(templateHaskell)+       -- || impl(haste)+        Buildable: False++Test-Suite test-quickcheck-gshrink+    type: exitcode-stdio-1.0+    hs-source-dirs: tests+    main-is: GShrinkExample.hs+    build-depends: base, QuickCheck == 2.9+    if impl(ghc < 7.2)+        buildable: False+    if impl(ghc >= 7.2) && impl(ghc < 7.6)+        build-depends: ghc-prim

@@ -14,7 +14,7 @@  and testing: ->>> quickcheck prop_commutativeAdd+>>> quickCheck prop_commutativeAdd +++ OK, passed 100 tests.  which tests @prop_commutativeAdd@ on 100 random @(Integer, Integer)@ pairs.@@ -184,6 +184,7 @@     -- *** Controlling property execution   , verbose   , once+  , again   , within   , noShrinking     -- *** Conjunction and disjunction

@@ -83,7 +83,7 @@         in isVar' . nameBase  infoType :: Info -> Type-#if __GLASGOW_HASKELL__ >= 711+#if MIN_VERSION_template_haskell(2,11,0) infoType (ClassOpI _ ty _) = ty infoType (DataConI _ ty _) = ty infoType (VarI _ ty _) = ty@@ -96,7 +96,7 @@ deconstructType :: Error -> Type -> Q ([Name], Cxt, Type) deconstructType err ty0@(ForallT xs ctx ty) = do   let plain (PlainTV  _)       = True-#if __GLASGOW_HASKELL__ >= 706+#if MIN_VERSION_template_haskell(2,8,0)       plain (KindedTV _ StarT) = True #else       plain (KindedTV _ StarK) = True@@ -129,7 +129,7 @@   ls <- runIO (fmap lines (readUTF8File filename))   let prefixes = map (takeWhile (\c -> isAlphaNum c || c == '_' || c == '\'') . dropWhile (\c -> isSpace c || c == '>')) ls       idents = nubBy (\x y -> snd x == snd y) (filter (("prop_" `isPrefixOf`) . snd) (zip [1..] prefixes))-#if __GLASGOW_HASKELL__ > 705+#if MIN_VERSION_template_haskell(2,8,0)       warning x = reportWarning ("Name " ++ x ++ " found in source file but was not in scope") #else       warning x = report False ("Name " ++ x ++ " found in source file but was not in scope")

@@ -104,6 +104,13 @@   , nub   ) +#ifndef NO_NONEMPTY+import Data.List.NonEmpty (NonEmpty (..), nonEmpty)+import Data.Maybe (mapMaybe)+#endif++import Data.Version (Version (..))+ import Control.Monad   ( liftM   , liftM2@@ -125,6 +132,11 @@ import qualified Data.IntMap as IntMap import qualified Data.Sequence as Sequence +import qualified Data.Monoid as Monoid++import Data.Functor.Identity+import Data.Functor.Constant+ -------------------------------------------------------------------------- -- ** class Arbitrary @@ -341,12 +353,15 @@   shrink (Right y) = [ Right y' | y' <- shrink y ]  instance Arbitrary a => Arbitrary [a] where-  arbitrary = sized $ \n ->-    do k <- choose (0,n)-       sequence [ arbitrary | _ <- [1..k] ]-+  arbitrary = listOf arbitrary   shrink xs = shrinkList shrink xs +#ifndef NO_NONEMPTY+instance Arbitrary a => Arbitrary (NonEmpty a) where+  arbitrary = liftM2 (:|) arbitrary arbitrary+  shrink (x :| xs) = mapMaybe nonEmpty . shrinkList shrink $ x : xs+#endif+ -- | Shrink a list of values given a shrinking function for individual values. shrinkList :: (a -> [a]) -> [a] -> [[a]] shrinkList shr xs = concat [ removes k n xs | k <- takeWhile (>0) (iterate (`div`2) n) ]@@ -425,6 +440,76 @@     [ (v', w', x', y', z')     | (v', (w', (x', (y', z')))) <- shrink (v, (w, (x, (y, z)))) ] +instance ( Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d, Arbitrary e+         , Arbitrary f+         )+      => Arbitrary (a,b,c,d,e,f)+ where+  arbitrary = return (,,,,,)+          <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary+          <*> arbitrary <*> arbitrary++  shrink (u, v, w, x, y, z) =+    [ (u', v', w', x', y', z')+    | (u', (v', (w', (x', (y', z'))))) <- shrink (u, (v, (w, (x, (y, z))))) ]++instance ( Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d, Arbitrary e+         , Arbitrary f, Arbitrary g+         )+      => Arbitrary (a,b,c,d,e,f,g)+ where+  arbitrary = return (,,,,,,)+          <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary+          <*> arbitrary <*> arbitrary <*> arbitrary++  shrink (t, u, v, w, x, y, z) =+    [ (t', u', v', w', x', y', z')+    | (t', (u', (v', (w', (x', (y', z')))))) <- shrink (t, (u, (v, (w, (x, (y, z)))))) ]++instance ( Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d, Arbitrary e+         , Arbitrary f, Arbitrary g, Arbitrary h+         )+      => Arbitrary (a,b,c,d,e,f,g,h)+ where+  arbitrary = return (,,,,,,,)+          <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary+          <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary++  shrink (s, t, u, v, w, x, y, z) =+    [ (s', t', u', v', w', x', y', z')+    | (s', (t', (u', (v', (w', (x', (y', z')))))))+      <- shrink (s, (t, (u, (v, (w, (x, (y, z))))))) ]++instance ( Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d, Arbitrary e+         , Arbitrary f, Arbitrary g, Arbitrary h, Arbitrary i+         )+      => Arbitrary (a,b,c,d,e,f,g,h,i)+ where+  arbitrary = return (,,,,,,,,)+          <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary+          <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary+          <*> arbitrary++  shrink (r, s, t, u, v, w, x, y, z) =+    [ (r', s', t', u', v', w', x', y', z')+    | (r', (s', (t', (u', (v', (w', (x', (y', z'))))))))+      <- shrink (r, (s, (t, (u, (v, (w, (x, (y, z)))))))) ]++instance ( Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d, Arbitrary e+         , Arbitrary f, Arbitrary g, Arbitrary h, Arbitrary i, Arbitrary j+         )+      => Arbitrary (a,b,c,d,e,f,g,h,i,j)+ where+  arbitrary = return (,,,,,,,,,)+          <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary+          <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary+          <*> arbitrary <*> arbitrary++  shrink (q, r, s, t, u, v, w, x, y, z) =+    [ (q', r', s', t', u', v', w', x', y', z')+    | (q', (r', (s', (t', (u', (v', (w', (x', (y', z')))))))))+      <- shrink (q, (r, (s, (t, (u, (v, (w, (x, (y, z))))))))) ]+ -- typical instance for primitive (numerical) types  instance Arbitrary Integer where@@ -520,6 +605,84 @@   arbitrary = fmap Sequence.fromList arbitrary   shrink = map Sequence.fromList . shrink . toList +-- Arbitrary instance for Ziplist+instance Arbitrary a => Arbitrary (ZipList a) where+  arbitrary = fmap ZipList arbitrary+  shrink = map ZipList . shrink . getZipList++-- Arbitrary instance for transformers' Functors+instance Arbitrary a => Arbitrary (Identity a) where+  arbitrary = fmap Identity arbitrary+  shrink = map Identity . shrink . runIdentity++instance Arbitrary a => Arbitrary (Constant a b) where+  arbitrary = fmap Constant arbitrary+  shrink = map Constant . shrink . getConstant++-- Arbitrary instance for Const+instance Arbitrary a => Arbitrary (Const a b) where+  arbitrary = fmap Const arbitrary+  shrink = map Const . shrink . getConst++-- Arbitrary instances for Monoid+instance Arbitrary a => Arbitrary (Monoid.Dual a) where+  arbitrary = fmap Monoid.Dual arbitrary+  shrink = map Monoid.Dual . shrink . Monoid.getDual++instance (Arbitrary a, CoArbitrary a) => Arbitrary (Monoid.Endo a) where+  arbitrary = fmap Monoid.Endo arbitrary+  shrink = map Monoid.Endo . shrink . Monoid.appEndo++instance Arbitrary Monoid.All where+  arbitrary = fmap Monoid.All arbitrary+  shrink = map Monoid.All . shrink . Monoid.getAll++instance Arbitrary Monoid.Any where+  arbitrary = fmap Monoid.Any arbitrary+  shrink = map Monoid.Any . shrink . Monoid.getAny++instance Arbitrary a => Arbitrary (Monoid.Sum a) where+  arbitrary = fmap Monoid.Sum arbitrary+  shrink = map Monoid.Sum . shrink . Monoid.getSum++instance Arbitrary a => Arbitrary (Monoid.Product a) where+  arbitrary = fmap Monoid.Product  arbitrary+  shrink = map Monoid.Product  . shrink . Monoid.getProduct++instance Arbitrary a => Arbitrary (Monoid.First a) where+  arbitrary = fmap Monoid.First arbitrary+  shrink = map Monoid.First . shrink . Monoid.getFirst++instance Arbitrary a => Arbitrary (Monoid.Last a) where+  arbitrary = fmap Monoid.Last arbitrary+  shrink = map Monoid.Last . shrink . Monoid.getLast++#if defined(MIN_VERSION_base)+#if MIN_VERSION_base(4,8,0)+instance Arbitrary (f a) => Arbitrary (Monoid.Alt f a) where+  arbitrary = fmap Monoid.Alt arbitrary+  shrink = map Monoid.Alt . shrink . Monoid.getAlt+#endif+#endif++-- | Generates 'Version' with non-empty non-negative @versionBranch@, and empty @versionTags@+instance Arbitrary Version where+  arbitrary = sized $ \n ->+    do k <- choose (0, log2 n)+       xs <- vectorOf (k+1) arbitrarySizedNatural+       return (Version xs [])+    where+      log2 :: Int -> Int+      log2 n | n <= 1 = 0+             | otherwise = 1 + log2 (n `div` 2)++  shrink (Version xs _) =+    [ Version xs' []+    | xs' <- shrink xs+    , length xs' > 0+    , all (>=0) xs'+    ]+ -- ** Helper functions for implementing arbitrary  -- | Generates an integral number. The number can be positive or negative@@ -585,9 +748,9 @@ arbitrarySizedBoundedIntegral =   withBounds $ \mn mx ->   sized $ \s ->-    do let bits n | n `quot` 2 == 0 = 0+    do let bits n | n == 0 = 0                   | otherwise = 1 + bits (n `quot` 2)-           k  = 2^(s*(bits mn `max` bits mx `max` 40) `div` 100)+           k  = 2^(s*(bits mn `max` bits mx `max` 40) `div` 80)        n <- choose (toInteger mn `max` (-k), toInteger mx `min` k)        return (fromInteger n) @@ -735,6 +898,11 @@   coarbitrary []     = variant 0   coarbitrary (x:xs) = variant 1 . coarbitrary (x,xs) +#ifndef NO_NONEMPTY+instance CoArbitrary a => CoArbitrary (NonEmpty a) where+  coarbitrary (x :| xs) = coarbitrary (x, xs)+#endif+ instance (Integral a, CoArbitrary a) => CoArbitrary (Ratio a) where   coarbitrary r = coarbitrary (numerator r,denominator r) @@ -836,6 +1004,56 @@   coarbitrary = coarbitrary . IntMap.toList instance CoArbitrary a => CoArbitrary (Sequence.Seq a) where   coarbitrary = coarbitrary . toList++-- CoArbitrary instance for Ziplist+instance CoArbitrary a => CoArbitrary (ZipList a) where+  coarbitrary = coarbitrary . getZipList++-- CoArbitrary instance for transformers' Functors+instance CoArbitrary a => CoArbitrary (Identity a) where+  coarbitrary = coarbitrary . runIdentity++instance CoArbitrary a => CoArbitrary (Constant a b) where+  coarbitrary = coarbitrary . getConstant++-- CoArbitrary instance for Const+instance CoArbitrary a => CoArbitrary (Const a b) where+  coarbitrary = coarbitrary . getConst++-- CoArbitrary instances for Monoid+instance CoArbitrary a => CoArbitrary (Monoid.Dual a) where+  coarbitrary = coarbitrary . Monoid.getDual++instance (Arbitrary a, CoArbitrary a) => CoArbitrary (Monoid.Endo a) where+  coarbitrary = coarbitrary . Monoid.appEndo++instance CoArbitrary Monoid.All where+  coarbitrary = coarbitrary . Monoid.getAll++instance CoArbitrary Monoid.Any where+  coarbitrary = coarbitrary . Monoid.getAny++instance CoArbitrary a => CoArbitrary (Monoid.Sum a) where+  coarbitrary = coarbitrary . Monoid.getSum++instance CoArbitrary a => CoArbitrary (Monoid.Product a) where+  coarbitrary = coarbitrary . Monoid.getProduct++instance CoArbitrary a => CoArbitrary (Monoid.First a) where+  coarbitrary = coarbitrary . Monoid.getFirst++instance CoArbitrary a => CoArbitrary (Monoid.Last a) where+  coarbitrary = coarbitrary . Monoid.getLast++#if defined(MIN_VERSION_base)+#if MIN_VERSION_base(4,8,0)+instance CoArbitrary (f a) => CoArbitrary (Monoid.Alt f a) where+  coarbitrary = coarbitrary . Monoid.getAlt+#endif+#endif++instance CoArbitrary Version where+  coarbitrary (Version a b) = coarbitrary (a, b)  -- ** Helpers for implementing coarbitrary 

@@ -6,37 +6,13 @@ {-# LANGUAGE CPP #-} module Test.QuickCheck.Exception where -#if !defined(__GLASGOW_HASKELL__) || (__GLASGOW_HASKELL__ < 609)+#if !defined(__GLASGOW_HASKELL__) || (__GLASGOW_HASKELL__ < 700) #define OLD_EXCEPTIONS #endif -#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 607-#define GHC_INTERRUPT--#if __GLASGOW_HASKELL__ < 613-#define GHCI_INTERRUPTED_EXCEPTION-#endif--#if __GLASGOW_HASKELL__ >= 700-#define NO_BASE_3-#endif-#endif- #if defined(NO_EXCEPTIONS)-#elif defined(OLD_EXCEPTIONS) || defined(NO_BASE_3)-import qualified Control.Exception as E #else-import qualified Control.Exception.Extensible as E-#endif--#if defined(GHC_INTERRUPT)-#if defined(GHCI_INTERRUPTED_EXCEPTION)-import Panic(GhcException(Interrupted))-#endif-import Data.Typeable-#if defined(OLD_EXCEPTIONS)-import Data.Dynamic-#endif+import qualified Control.Exception as E #endif  #if defined(NO_EXCEPTIONS)@@ -90,21 +66,12 @@ -- QuickCheck won't try to shrink an interrupted test case. isInterrupt :: AnException -> Bool -#if defined(GHC_INTERRUPT) #if defined(OLD_EXCEPTIONS)-isInterrupt (E.DynException e) = fromDynamic e == Just Interrupted isInterrupt _ = False-#elif defined(GHCI_INTERRUPTED_EXCEPTION)-isInterrupt e =-  E.fromException e == Just Interrupted || E.fromException e == Just E.UserInterrupt #else isInterrupt e = E.fromException e == Just E.UserInterrupt #endif -#else /* !defined(GHC_INTERRUPT) */-isInterrupt _ = False-#endif- -- | A special exception that makes QuickCheck discard the test case. -- Normally you should use '==>', but if for some reason this isn't -- possible (e.g. you are deep inside a generator), use 'discard'@@ -120,8 +87,8 @@   isDiscard (E.ErrorCall msg') = msg' == msg   isDiscard _ = False #else-  isDiscard (E.SomeException e) =-    case cast e of+  isDiscard e =+    case E.fromException e of       Just (E.ErrorCall msg') -> msg' == msg       _ -> False #endif

@@ -4,6 +4,10 @@ {-# LANGUAGE PatternSynonyms #-} #endif +#ifndef NO_GENERICS+{-# LANGUAGE DefaultSignatures, FlexibleContexts #-}+#endif+ -- | Generation of random shrinkable, showable functions. -- See the paper \"Shrinking and showing functions\" by Koen Claessen. --@@ -29,6 +33,9 @@   , Function(..)   , functionMap   , functionShow+  , functionIntegral+  , functionRealFrac+  , functionBoundedEnum #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708   , pattern Fn #endif@@ -47,7 +54,32 @@ import Data.Maybe( fromJust ) import Data.Ratio import Control.Arrow( (&&&) )+import qualified Data.IntMap as IntMap+import qualified Data.IntSet as IntSet+import qualified Data.Map as Map+import qualified Data.Set as Set+import qualified Data.Sequence as Sequence+import Data.Int+import Data.Word+import Data.Complex+import Data.Foldable(toList) +#ifndef NO_FIXED+import Data.Fixed+#endif++#ifndef NO_NATURALS+import Numeric.Natural+#endif++#ifndef NO_NONEMPTY+import Data.List.NonEmpty(NonEmpty(..))+#endif++#ifndef NO_GENERICS+import GHC.Generics hiding (C)+#endif+ -------------------------------------------------------------------------- -- concrete functions @@ -105,21 +137,55 @@  class Function a where   function :: (a->b) -> (a:->b)+#ifndef NO_GENERICS+  default function :: (Generic a, GFunction (Rep a)) => (a->b) -> (a:->b)+  function = genericFunction+#endif  -- basic instances +-- | Provides a 'Function' instance for types with 'Bounded' and 'Enum'.+-- Use only for small types (i.e. not integers): creates+-- the list @['minBound'..'maxBound']@!+functionBoundedEnum :: (Eq a, Bounded a, Enum a) => (a->b) -> (a:->b)+functionBoundedEnum f = Table [(x,f x) | x <- [minBound..maxBound]]++-- | Provides a 'Function' instance for types with 'RealFrac'.+functionRealFrac :: RealFrac a => (a->b) -> (a:->b)+functionRealFrac = functionMap toRational fromRational++-- | Provides a 'Function' instance for types with 'Integral'.+functionIntegral :: Integral a => (a->b) -> (a:->b)+functionIntegral = functionMap fromIntegral fromInteger++-- | Provides a 'Function' instance for types with 'Show' and 'Read'.+functionShow :: (Show a, Read a) => (a->c) -> (a:->c)+functionShow f = functionMap show read f++-- | The basic building block for 'Function' instances.+-- Provides a 'Function' instance by mapping to and from a type that+-- already has a 'Function' instance.+functionMap :: Function b => (a->b) -> (b->a) -> (a->c) -> (a:->c)+functionMap = functionMapWith function++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)))+ instance Function () where   function f = Unit (f ()) -instance Function Word8 where-  function f = Table [(x,f x) | x <- [0..255]]- instance (Function a, Function b) => Function (a,b) where-  function f = Pair (function `fmap` function (curry f))+  function = functionPairWith function function +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 f = function (f . Left) :+: function (f . Right)+  function = functionEitherWith function function +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)+ -- tuple convenience instances  instance (Function a, Function b, Function c) => Function (a,b,c) where@@ -139,12 +205,6 @@  -- other instances -functionMap :: Function b => (a->b) -> (b->a) -> (a->c) -> (a:->c)-functionMap g h f = Map g h (function (\b -> f (h b)))--functionShow :: (Show a, Read a) => (a->c) -> (a:->c)-functionShow f = functionMap show read f- instance Function a => Function [a] where   function = functionMap g h    where@@ -188,17 +248,99 @@     hNatural (w:ws) = fromIntegral w + 256 * hNatural ws  instance Function Int where-  function = functionMap fromIntegral fromInteger+  function = functionIntegral  instance Function Char where-  function = functionMap ord' chr'+  function = functionMap ord chr++instance Function Float where+  function = functionRealFrac++instance Function Double where+  function = functionRealFrac++-- instances for assorted types in the base package++instance Function Ordering where+  function = functionMap g h+    where+      g LT = Left False+      g EQ = Left True+      g GT = Right ()++      h (Left False) = LT+      h (Left True)  = EQ+      h (Right _)    = GT++#ifndef NO_NONEMPTY+instance Function a => Function (NonEmpty a) where+  function = functionMap g h    where-    ord' c = fromIntegral (ord c) :: Word8-    chr' n = chr (fromIntegral n)+     g (x :| xs) = (x,   xs)+     h (x,   xs) =  x :| xs+#endif -instance (Function a, Integral a) => Function (Ratio a) where-  function = functionMap (numerator &&& denominator) (uncurry (%))+instance (Integral a, Function a) => Function (Ratio a) where+  function = functionMap g h+   where+     g r = (numerator r, denominator r)+     h (n, d) = n % d +#ifndef NO_FIXED+instance HasResolution a => Function (Fixed a) where+  function = functionRealFrac+#endif++instance (RealFloat a, Function a) => Function (Complex a) where+  function = functionMap g h+   where+     g (x :+ y) = (x,   y)+     h (x,   y) =  x :+ y++instance (Ord a, Function a) => Function (Set.Set a) where+  function = functionMap Set.toList Set.fromList++instance (Ord a, Function a, Function b) => Function (Map.Map a b) where+  function = functionMap Map.toList Map.fromList++instance Function IntSet.IntSet where+  function = functionMap IntSet.toList IntSet.fromList++instance Function a => Function (IntMap.IntMap a) where+  function = functionMap IntMap.toList IntMap.fromList++instance Function a => Function (Sequence.Seq a) where+  function = functionMap toList Sequence.fromList++#ifndef NO_NATURALS+instance Function Natural where+  function = functionIntegral+#endif++instance Function Int8 where+  function = functionBoundedEnum++instance Function Int16 where+  function = functionIntegral++instance Function Int32 where+  function = functionIntegral++instance Function Int64 where+  function = functionIntegral++instance Function Word8 where+  function = functionBoundedEnum++instance Function Word16 where+  function = functionIntegral++instance Function Word32 where+  function = functionIntegral++instance Function Word64 where+  function = functionIntegral+ -- poly instances  instance Function A where@@ -226,6 +368,41 @@   shrink    = shrinkFun shrink  --------------------------------------------------------------------------+-- generic function instances++#ifndef NO_GENERICS+-- | Generic 'Function' implementation.+genericFunction :: (Generic a, GFunction (Rep a)) => (a->b) -> (a:->b)+genericFunction = functionMapWith gFunction from to++class GFunction f where+  gFunction :: (f a -> b) -> (f a :-> b)++instance GFunction U1 where+  gFunction = functionMap (\U1 -> ()) (\() -> U1)++instance (GFunction f, GFunction g) => GFunction (f :*: g) where+  gFunction = functionMapWith (functionPairWith gFunction gFunction) g h+   where+     g (x :*: y) = (x, y)+     h (x, y) = x :*: y++instance (GFunction f, GFunction g) => GFunction (f :+: g) where+  gFunction = functionMapWith (functionEitherWith gFunction gFunction) g h+   where+     g (L1 x) = Left x+     g (R1 x) = Right x+     h (Left x) = L1 x+     h (Right x) = R1 x++instance GFunction f => GFunction (M1 i c f) where+  gFunction = functionMapWith gFunction (\(M1 x) -> x) M1++instance Function a => GFunction (K1 i a) where+  gFunction = functionMap (\(K1 x) -> x) K1+#endif++-------------------------------------------------------------------------- -- shrinking  shrinkFun :: (c -> [c]) -> (a :-> c) -> [a :-> c]@@ -272,7 +449,7 @@ -------------------------------------------------------------------------- -- the Fun modifier -data Fun a b = Fun (a :-> b, b) (a -> b)+data Fun a b = Fun (a :-> b, b, Bool) (a -> b)  #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708 -- | A pattern for matching against the function only:@@ -284,13 +461,14 @@ #endif  mkFun :: (a :-> b) -> b -> Fun a b-mkFun p d = Fun (p,d) (abstract p d)+mkFun p d = Fun (p, d, False) (abstract p d)  apply :: Fun a b -> (a -> b) apply (Fun _ f) = f  instance (Show a, Show b) => Show (Fun a b) where-  show (Fun (p,d) _) = showFunction p (Just d)+  show (Fun (_, _, False) _) = "<fun>"+  show (Fun (p, d, True) _)  = showFunction p (Just d)  instance (Function a, CoArbitrary a, Arbitrary b) => Arbitrary (Fun a b) where   arbitrary =@@ -298,8 +476,9 @@        d <- arbitrary        return (mkFun p d) -  shrink (Fun (p,d) _) =-    [ mkFun p' d' | (p', d') <- shrink (p, d) ]+  shrink (Fun (p, d, b) f) =+    [ mkFun p' d' | (p', d') <- shrink (p, d) ] +++    [ Fun (p, d, True) f | not b ]  -------------------------------------------------------------------------- -- the end.

@@ -83,10 +83,6 @@ class Testable prop where   -- | Convert the thing to a property.   property :: prop -> Property-  -- | If true, the property will only be tested once.-  -- However, if used inside a quantifier, it will be tested normally.-  exhaustive :: prop -> Bool-  exhaustive _ = False  -- | If a property returns 'Discard', the current test case is discarded, -- the same as if a precondition was false.@@ -94,19 +90,15 @@  instance Testable Discard where   property _ = property rejected-  exhaustive _ = True  instance Testable Bool where   property = property . liftBool-  exhaustive _ = True  instance Testable Result where   property = MkProperty . return . MkProp . protectResults . return-  exhaustive _ = True  instance Testable Prop where   property (MkProp r) = MkProperty . return . MkProp . ioRose . return $ r-  exhaustive _ = True  instance Testable prop => Testable (Gen prop) where   property mp = MkProperty $ do p <- mp; unProperty (property p)@@ -125,6 +117,11 @@ -- -- For more advanced monadic testing you may want to look at -- "Test.QuickCheck.Monadic".+--+-- Note that if you use 'ioProperty' on a property of type @IO Bool@,+-- or more generally a property that does no quantification, the property+-- will only be executed once. To test the property repeatedly you must+-- use the 'again' combinator. ioProperty :: Testable prop => IO prop -> Property ioProperty = MkProperty . fmap (MkProp . ioRose . fmap unProp) . promote . fmap (unProperty . property) @@ -243,7 +240,7 @@       , expect       = True       , reason       = ""       , theException = Nothing-      , abort        = False+      , abort        = True       , labels       = Map.empty       , stamp        = Set.empty       , callbacks    = []@@ -348,6 +345,10 @@ once :: Testable prop => prop -> Property once = mapTotalResult (\res -> res{ abort = True }) +-- | Undoes the effect of 'once'.+again :: Testable prop => prop -> Property+again = mapTotalResult (\res -> res{ abort = False })+ -- | Attaches a label to a property. This is used for reporting -- test case distribution. label :: Testable prop => String -> prop -> Property@@ -421,6 +422,7 @@ forAllShrink :: (Show a, Testable prop)              => Gen a -> (a -> [a]) -> (a -> prop) -> Property forAllShrink gen shrinker pf =+  again $   MkProperty $   gen >>= \x ->     unProperty $@@ -432,6 +434,7 @@ -- makes 100 random choices. (.&.) :: (Testable prop1, Testable prop2) => prop1 -> prop2 -> Property p1 .&. p2 =+  again $   MkProperty $   arbitrary >>= \b ->     unProperty $@@ -445,6 +448,7 @@ -- | Take the conjunction of several properties. conjoin :: Testable prop => [prop] -> Property conjoin ps =+  again $   MkProperty $   do roses <- mapM (fmap unProp . unProperty . property) ps      return (MkProp (conj id roses))@@ -481,6 +485,7 @@ -- | Take the disjunction of several properties. disjoin :: Testable prop => [prop] -> Property disjoin ps =+  again $   MkProperty $   do roses <- mapM (fmap unProp . unProperty . property) ps      return (MkProp (foldr disj (MkRose failed []) roses))

@@ -68,13 +68,13 @@   readsPrec n xs = [(QCGen g, ys) | (g, ys) <- readsPrec n xs]  instance RandomGen QCGen where-  split (QCGen g) = (QCGen g1, QCGen g2)-    where-      (g1, g2) = split g+  split (QCGen g) =+    case split g of+      (g1, g2) -> (QCGen g1, QCGen g2)   genRange (QCGen g) = genRange g-  next (QCGen g) = (x, QCGen g')-    where-      (x, g') = next g+  next (QCGen g) =+    case next g of+      (x, g') -> (x, QCGen g')  newQCGen :: IO QCGen newQCGen = fmap QCGen newTheGen

@@ -17,7 +17,13 @@ import Test.QuickCheck.Exception import Test.QuickCheck.Random import System.Random(split)+#if defined(MIN_VERSION_containers)+#if MIN_VERSION_containers(0,5,0)+import qualified Data.Map.Strict as Map+#else import qualified Data.Map as Map+#endif+#endif import qualified Data.Set as Set  import Data.Char@@ -146,7 +152,7 @@                  , numSuccessShrinks         = 0                  , numTryShrinks             = 0                  , numTotTryShrinks          = 0-                 } (unGen (unProperty (property' p)))+                 } (unGen (unProperty (property p)))   where computeSize' n d           -- e.g. with maxSuccess = 250, maxSize = 100, goes like this:           -- 0, 1, 2, ..., 99, 0, 1, 2, ..., 99, 0, 2, 4, ..., 98.@@ -158,9 +164,6 @@         n `roundTo` m = (n `div` m) * m         at0 f s 0 0 = s         at0 f s n d = f n d-        property' p-          | exhaustive p = once (property p)-          | otherwise = property p  -- | Tests a property and prints the results and all test cases generated to 'stdout'. -- This is just a convenience function that means the same as @'quickCheck' . 'verbose'@.

@@ -1,3 +1,18 @@+QuickCheck 2.9 (released 2016-07-10)+	* Arbitrary, CoArbitrary and Function instances for more types+	* Generics for automatic Function instances+	* A new combinator "again" which undoes the effect of "once"+	* Remove "exhaustive" from Testable typeclass;+	  instead, combinators which are nonexhaustive (such as forAll)+	  call "again", which should be more robust++	* Drop support for GHC 6.x++	* Fixed bugs:+		* arbitrarySizedBoundedIntegral wasn't generating huge integers+		* verboseCheck failed with Test.QuickCheck.Function+		* label had a space leak+ QuickCheck 2.8.2 (released 2016-01-15) 	* GHC 8 support 	* Add Arbitrary and CoArbitrary instances for types in

@@ -0,0 +1,20 @@+{-# LANGUAGE DeriveGeneric, ScopedTypeVariables #-}++module Main where++import GHC.Generics (Generic)+import Test.QuickCheck+import Test.QuickCheck.Function++data D a = C1 a | C2 deriving (Eq, Show, Read, Generic)+++instance Arbitrary a => Arbitrary (D a)+instance CoArbitrary a => CoArbitrary (D a)++instance (Show a, Read a) => Function (D a) where+  function = functionShow++main :: IO ()+main = quickCheck $ \(Fun _ f) ->+  f (C1 (2::Int)) `elem` [0, 1 :: Int]

@@ -0,0 +1,17 @@+{-# LANGUAGE DeriveGeneric, ScopedTypeVariables #-}++module Main where++import GHC.Generics (Generic)+import Test.QuickCheck++data Nat = Z | S Nat deriving (Eq, Show, Generic)+++instance Arbitrary Nat+++main :: IO ()+main = do+  print $ genericShrink (S (S Z)) == [S Z]+  print $ genericShrink [0::Int] == [[]]

@@ -0,0 +1,146 @@+{-# LANGUAGE TemplateHaskell, GeneralizedNewtypeDeriving, Rank2Types, NoMonomorphismRestriction #-}+import Test.QuickCheck+import Test.QuickCheck.Gen.Unsafe+import Data.List+import Data.Int+import Data.Word+import Data.Version (showVersion, parseVersion)+import Text.ParserCombinators.ReadP (readP_to_S)++newtype Path a = Path [a] deriving (Show, Functor)++instance Arbitrary a => Arbitrary (Path a) where+  arbitrary = do+    x <- arbitrary+    fmap Path (pathFrom x)+    where+      pathFrom x = sized $ \n ->+        fmap (x:) $+        oneof $+          [return []] +++          [resize (n-1) (pathFrom y) | n > 0, y <- shrink x]++  shrink (Path xs) = map Path [ ys | ys <- inits xs, length ys > 0 && length ys < length xs ]++path :: (a -> Bool) -> Path a -> Bool+path p (Path xs) = all p xs++somePath :: (a -> Bool) -> Path a -> Property+somePath p = expectFailure . path (not . p)++newtype Extremal a = Extremal { getExtremal :: a } deriving (Show, Eq, Ord, Num, Enum, Real, Integral)++instance (Arbitrary a, Bounded a) => Arbitrary (Extremal a) where+  arbitrary =+    fmap Extremal $+    frequency+      [(1, return minBound),+       (1, return maxBound),+       (8, arbitrary)]+  shrink (Extremal x) = map Extremal (shrink x)++smallProp :: Integral a => Path a -> Bool+smallProp = path (\x -> (x >= -100 || -100 `asTypeOf` x >= 0) && x <= 100)++largeProp :: Integral a => Path a -> Property+largeProp = somePath (\x -> x < -1000000 || x > 1000000)++prop_int :: Path Int -> Bool+prop_int = smallProp++prop_int32 :: Path Int32 -> Property+prop_int32 = largeProp++prop_word :: Path Word -> Property+prop_word = largeProp++prop_word32 :: Path Word32 -> Property+prop_word32 = largeProp++prop_integer :: Path Integer -> Bool+prop_integer = smallProp++prop_small :: Path (Small Int) -> Bool+prop_small = smallProp++prop_large :: Path (Large Int) -> Property+prop_large = largeProp++prop_smallWord :: Path (Small Word) -> Bool+prop_smallWord = smallProp++prop_largeWord :: Path (Large Word) -> Property+prop_largeWord = largeProp++data Choice a b = Choice a b deriving Show+instance (Arbitrary a, Arbitrary b) => Arbitrary (Choice a b) where+  arbitrary = do+    Capture eval <- capture+    return (Choice (eval arbitrary) (eval arbitrary))++idemProp :: (Eq a, Arbitrary a, Arbitrary b) => (b -> a) -> Choice a b -> Bool+idemProp f (Choice x y) = x == f y++prop_fixed_length :: Arbitrary a => Path (Fixed a) -> Bool+prop_fixed_length (Path xs) = length xs == 1++prop_fixed_idem = idemProp getFixed+prop_blind_idem = idemProp getBlind++prop_ordered_list = path (\(Ordered xs) -> sort xs == xs)+prop_nonempty_list = path (\(NonEmpty xs) -> not (null xs))++pathInt, somePathInt ::+  (Arbitrary (f (Extremal Int)), Show (f (Extremal Int)),+   Arbitrary (f Integer), Show (f Integer),+   Arbitrary (f (Extremal Int8)), Show (f (Extremal Int8)),+   Arbitrary (f (Extremal Int16)), Show (f (Extremal Int16)),+   Arbitrary (f (Extremal Int32)), Show (f (Extremal Int32)),+   Arbitrary (f (Extremal Int64)), Show (f (Extremal Int64)),+   Arbitrary (f (Extremal Word)), Show (f (Extremal Word)),+   Arbitrary (f (Extremal Word8)), Show (f (Extremal Word8)),+   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 =+  conjoin+    [counterexample "Int" (path ((p :: Int -> Bool) . getExtremal . f)),+     counterexample "Integer" (path ((p :: Integer -> Bool) . f)),+     counterexample "Int8" (path ((p :: Int8 -> Bool) . getExtremal . f)),+     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))++prop_positive = pathInt getPositive (> 0)+prop_positive_bound = somePathInt getPositive (== 1)++prop_nonzero = pathInt getNonZero (/= 0)+prop_nonzero_bound_1 = somePathInt getNonZero (== 1)+prop_nonzero_bound_2 = somePathInt getNonZero (== -1)++prop_nonnegative = pathInt getNonNegative (>= 0)+prop_nonnegative_bound = somePathInt getNonNegative (== 0)++reachesBound :: (Bounded a, Integral a, Arbitrary a) =>+  a -> Property+reachesBound x = expectFailure (x < 3 * (maxBound `div` 4))++prop_reachesBound_Int8 = reachesBound :: Int8 -> Property+prop_reachesBound_Int16 = reachesBound :: Int16 -> Property+prop_reachesBound_Int32 = reachesBound :: Int32 -> Property+prop_reachesBound_Int64 = reachesBound :: Int64 -> Property+prop_reachesBound_Word = reachesBound :: Word -> Property+prop_reachesBound_Word8 = reachesBound :: Word8 -> Property+prop_reachesBound_Word16 = reachesBound :: Word16 -> Property+prop_reachesBound_Word32 = reachesBound :: Word32 -> Property+prop_reachesBound_Word64 = reachesBound :: Word64 -> Property++return []+main = $quickCheckAll >>= print