Hello community, here is the log from the commit of package ghc-QuickCheck for openSUSE:Factory checked in at 2017-03-14 10:04:15 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-QuickCheck (Old) and /work/SRC/openSUSE:Factory/.ghc-QuickCheck.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-QuickCheck" Tue Mar 14 10:04:15 2017 rev:12 rq:461525 version:2.9.2 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-QuickCheck/ghc-QuickCheck.changes 2016-07-21 08:15:16.000000000 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-QuickCheck.new/ghc-QuickCheck.changes 2017-03-14 10:04:16.359700125 +0100 @@ -1,0 +2,5 @@ +Sun Feb 12 14:13:28 UTC 2017 - [email protected] + +- Update to version 2.9.2 with cabal2obs. + +------------------------------------------------------------------- Old: ---- QuickCheck-2.8.2.tar.gz New: ---- QuickCheck-2.9.2.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-QuickCheck.spec ++++++ --- /var/tmp/diff_new_pack.DTNQzk/_old 2017-03-14 10:04:16.919620840 +0100 +++ /var/tmp/diff_new_pack.DTNQzk/_new 2017-03-14 10:04:16.923620274 +0100 @@ -1,7 +1,7 @@ # # spec file for package ghc-QuickCheck # -# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -19,15 +19,14 @@ %global pkg_name QuickCheck %bcond_with tests Name: ghc-%{pkg_name} -Version: 2.8.2 +Version: 2.9.2 Release: 0 Summary: Automatic testing of Haskell programs License: BSD-3-Clause -Group: System/Libraries +Group: Development/Languages/Other Url: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz BuildRequires: ghc-Cabal-devel -# Begin cabal-rpm deps: BuildRequires: ghc-containers-devel BuildRequires: ghc-random-devel BuildRequires: ghc-rpm-macros @@ -38,7 +37,6 @@ %if %{with tests} BuildRequires: ghc-test-framework-devel %endif -# End cabal-rpm deps %description QuickCheck is a library for random testing of program properties. @@ -68,20 +66,14 @@ %prep %setup -q -n %{pkg_name}-%{version} - %build %ghc_lib_build - %install %ghc_lib_install - %check -%if %{with tests} -%{cabal} test -%endif - +%cabal_test %post devel %ghc_pkg_recache ++++++ QuickCheck-2.8.2.tar.gz -> QuickCheck-2.9.2.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/QuickCheck-2.8.2/LICENSE new/QuickCheck-2.9.2/LICENSE --- old/QuickCheck-2.8.2/LICENSE 2016-01-15 17:09:16.000000000 +0100 +++ new/QuickCheck-2.9.2/LICENSE 2016-09-15 12:03:42.000000000 +0200 @@ -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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/QuickCheck-2.8.2/QuickCheck.cabal new/QuickCheck-2.9.2/QuickCheck.cabal --- old/QuickCheck-2.8.2/QuickCheck.cabal 2016-01-15 17:09:16.000000000 +0100 +++ new/QuickCheck-2.9.2/QuickCheck.cabal 2016-09-15 12:03:42.000000000 +0200 @@ -1,15 +1,15 @@ Name: QuickCheck -Version: 2.8.2 +Version: 2.9.2 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 <[email protected]> Maintainer: QuickCheck developers <[email protected]> Bug-reports: mailto:[email protected] -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.2 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,17 @@ -- 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) 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,14 +88,24 @@ cpp-options: -DNO_SAFE_HASKELL -- Use tf-random on newer GHCs. - if impl(ghc >= 7) && (flag(base4point8) || flag(base4)) + if impl(ghc) 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) @@ -160,7 +134,7 @@ build-depends: base, containers, - QuickCheck == 2.8.2, + QuickCheck == 2.9.2, template-haskell >= 2.4, test-framework >= 0.4 && < 0.9 if flag(templateHaskell) @@ -168,3 +142,30 @@ 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.2 + 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.2 + if !flag(templateHaskell) + 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.2 + if impl(ghc < 7.2) + buildable: False + if impl(ghc >= 7.2) && impl(ghc < 7.6) + build-depends: ghc-prim diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/QuickCheck-2.8.2/Test/QuickCheck/All.hs new/QuickCheck-2.9.2/Test/QuickCheck/All.hs --- old/QuickCheck-2.8.2/Test/QuickCheck/All.hs 2016-01-15 17:09:16.000000000 +0100 +++ new/QuickCheck-2.9.2/Test/QuickCheck/All.hs 2016-09-15 12:03:42.000000000 +0200 @@ -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") diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/QuickCheck-2.8.2/Test/QuickCheck/Arbitrary.hs new/QuickCheck-2.9.2/Test/QuickCheck/Arbitrary.hs --- old/QuickCheck-2.8.2/Test/QuickCheck/Arbitrary.hs 2016-01-15 17:09:16.000000000 +0100 +++ new/QuickCheck-2.9.2/Test/QuickCheck/Arbitrary.hs 2016-09-15 12:03:42.000000000 +0200 @@ -36,7 +36,6 @@ , shrinkList -- :: (a -> [a]) -> [a] -> [[a]] , shrinkIntegral -- :: Integral a => a -> [a] , shrinkRealFrac -- :: RealFrac a => a -> [a] - , shrinkRealFracToInteger -- :: RealFrac a => a -> [a] -- ** Helper functions for implementing coarbitrary , coarbitraryIntegral -- :: Integral a => a -> Gen b -> Gen b , coarbitraryReal -- :: Real a => a -> Gen b -> Gen b @@ -104,6 +103,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 +131,13 @@ import qualified Data.IntMap as IntMap import qualified Data.Sequence as Sequence +import qualified Data.Monoid as Monoid + +#ifndef NO_TRANSFORMERS +import Data.Functor.Identity +import Data.Functor.Constant +#endif + -------------------------------------------------------------------------- -- ** class Arbitrary @@ -341,12 +354,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) ] @@ -376,7 +392,7 @@ instance Integral a => Arbitrary (Ratio a) where arbitrary = arbitrarySizedFractional - shrink = shrinkRealFracToInteger + shrink = shrinkRealFrac instance (RealFloat a, Arbitrary a) => Arbitrary (Complex a) where arbitrary = liftM2 (:+) arbitrary arbitrary @@ -425,6 +441,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 +606,88 @@ 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 + +#ifndef NO_TRANSFORMERS +-- 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 +#endif + +-- 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 + +#if defined(MIN_VERSION_base) +#if MIN_VERSION_base(3,0,0) +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 +#endif + +#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 +753,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) @@ -615,26 +783,15 @@ (True, False) -> a + b < 0 (False, True) -> a + b > 0 --- | Shrink a fraction, but only shrink to integral values. -shrinkRealFracToInteger :: RealFrac a => a -> [a] -shrinkRealFracToInteger x = +-- | Shrink a fraction. +shrinkRealFrac :: RealFrac a => a -> [a] +shrinkRealFrac x = nub $ [ -x | x < 0 ] ++ map fromInteger (shrinkIntegral (truncate x)) --- | Shrink a fraction. -shrinkRealFrac :: RealFrac a => a -> [a] -shrinkRealFrac x = - nub $ - shrinkRealFracToInteger x ++ - [ x - x' - | x' <- take 20 (iterate (/ 2) x) - , (x - x') << x ] - where - a << b = abs a < abs b - -------------------------------------------------------------------------- -- ** CoArbitrary @@ -735,6 +892,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) @@ -837,6 +999,60 @@ 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 + +#ifndef NO_TRANSFORMERS +-- 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 +#endif + +-- 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 + +#if defined(MIN_VERSION_base) +#if MIN_VERSION_base(3,0,0) +instance CoArbitrary a => CoArbitrary (Monoid.First a) where + coarbitrary = coarbitrary . Monoid.getFirst + +instance CoArbitrary a => CoArbitrary (Monoid.Last a) where + coarbitrary = coarbitrary . Monoid.getLast +#endif + +#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 -- | A 'coarbitrary' implementation for integral numbers. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/QuickCheck-2.8.2/Test/QuickCheck/Exception.hs new/QuickCheck-2.9.2/Test/QuickCheck/Exception.hs --- old/QuickCheck-2.8.2/Test/QuickCheck/Exception.hs 2016-01-15 17:09:16.000000000 +0100 +++ new/QuickCheck-2.9.2/Test/QuickCheck/Exception.hs 2016-09-15 12:03:42.000000000 +0200 @@ -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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/QuickCheck-2.8.2/Test/QuickCheck/Function.hs new/QuickCheck-2.9.2/Test/QuickCheck/Function.hs --- old/QuickCheck-2.8.2/Test/QuickCheck/Function.hs 2016-01-15 17:09:16.000000000 +0100 +++ new/QuickCheck-2.9.2/Test/QuickCheck/Function.hs 2016-09-15 12:03:42.000000000 +0200 @@ -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,6 +54,31 @@ 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,20 +137,54 @@ 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 @@ -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,16 +248,98 @@ 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 @@ -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. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/QuickCheck-2.8.2/Test/QuickCheck/Gen.hs new/QuickCheck-2.9.2/Test/QuickCheck/Gen.hs --- old/QuickCheck-2.8.2/Test/QuickCheck/Gen.hs 2016-01-15 17:09:16.000000000 +0100 +++ new/QuickCheck-2.9.2/Test/QuickCheck/Gen.hs 2016-09-15 12:03:42.000000000 +0200 @@ -11,6 +11,7 @@ import System.Random ( Random , StdGen + , random , randomR , split , newStdGen @@ -90,6 +91,10 @@ choose :: Random a => (a,a) -> Gen a choose rng = MkGen (\r _ -> let (x,_) = randomR rng r in x) +-- | Generates a random element over the natural range of `a`. +chooseAny :: Random a => Gen a +chooseAny = MkGen (\r _ -> let (x,_) = random r in x) + -- | 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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/QuickCheck-2.8.2/Test/QuickCheck/Property.hs new/QuickCheck-2.9.2/Test/QuickCheck/Property.hs --- old/QuickCheck-2.8.2/Test/QuickCheck/Property.hs 2016-01-15 17:09:16.000000000 +0100 +++ new/QuickCheck-2.9.2/Test/QuickCheck/Property.hs 2016-09-15 12:03:42.000000000 +0200 @@ -67,26 +67,12 @@ -- * Property and Testable types -- | The type of properties. --- --- Backwards combatibility note: in older versions of QuickCheck --- 'Property' was a type synonym for @'Gen' 'Prop'@, so you could mix --- and match property combinators and 'Gen' monad operations. Code --- that does this will no longer typecheck. --- However, it is easy to fix: because of the 'Testable' typeclass, any --- combinator that expects a 'Property' will also accept a @'Gen' 'Property'@. --- If you have a 'Property' where you need a @'Gen' 'a'@, simply wrap --- the property combinator inside a 'return' to get a @'Gen' 'Property'@, and --- all should be well. newtype Property = MkProperty { unProperty :: Gen Prop } -- | The class of things which can be tested, i.e. turned into a property. 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,22 +80,18 @@ 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) + property mp = MkProperty $ do p <- mp; unProperty (again p) instance Testable Property where property = property . unProperty @@ -125,6 +107,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 +230,7 @@ , expect = True , reason = "" , theException = Nothing - , abort = False + , abort = True , labels = Map.empty , stamp = Set.empty , callbacks = [] @@ -348,6 +335,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 @@ -412,15 +403,13 @@ -- test case generator. forAll :: (Show a, Testable prop) => Gen a -> (a -> prop) -> Property -forAll gen pf = - MkProperty $ - gen >>= \x -> - unProperty (counterexample (show x) (pf x)) +forAll gen pf = forAllShrink gen (\_ -> []) pf -- | Like 'forAll', but tries to shrink the argument for failing test cases. forAllShrink :: (Show a, Testable prop) => Gen a -> (a -> [a]) -> (a -> prop) -> Property forAllShrink gen shrinker pf = + again $ MkProperty $ gen >>= \x -> unProperty $ @@ -432,6 +421,7 @@ -- makes 100 random choices. (.&.) :: (Testable prop1, Testable prop2) => prop1 -> prop2 -> Property p1 .&. p2 = + again $ MkProperty $ arbitrary >>= \b -> unProperty $ @@ -445,6 +435,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 +472,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)) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/QuickCheck-2.8.2/Test/QuickCheck/Random.hs new/QuickCheck-2.9.2/Test/QuickCheck/Random.hs --- old/QuickCheck-2.8.2/Test/QuickCheck/Random.hs 2016-01-15 17:09:16.000000000 +0100 +++ new/QuickCheck-2.9.2/Test/QuickCheck/Random.hs 2016-09-15 12:03:42.000000000 +0200 @@ -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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/QuickCheck-2.8.2/Test/QuickCheck/Test.hs new/QuickCheck-2.9.2/Test/QuickCheck/Test.hs --- old/QuickCheck-2.8.2/Test/QuickCheck/Test.hs 2016-01-15 17:09:16.000000000 +0100 +++ new/QuickCheck-2.9.2/Test/QuickCheck/Test.hs 2016-09-15 12:03:42.000000000 +0200 @@ -17,7 +17,15 @@ 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 +#else +import qualified Data.Map as Map +#endif import qualified Data.Set as Set import Data.Char @@ -146,7 +154,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 +166,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'@. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/QuickCheck-2.8.2/Test/QuickCheck.hs new/QuickCheck-2.9.2/Test/QuickCheck.hs --- old/QuickCheck-2.8.2/Test/QuickCheck.hs 2016-01-15 17:09:16.000000000 +0100 +++ new/QuickCheck-2.9.2/Test/QuickCheck.hs 2016-09-15 12:03:42.000000000 +0200 @@ -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. @@ -146,7 +146,6 @@ , shrinkList , shrinkIntegral , shrinkRealFrac - , shrinkRealFracToInteger -- ** Helper functions for implementing coarbitrary , variant , coarbitraryIntegral @@ -184,6 +183,7 @@ -- *** Controlling property execution , verbose , once + , again , within , noShrinking -- *** Conjunction and disjunction diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/QuickCheck-2.8.2/changelog new/QuickCheck-2.9.2/changelog --- old/QuickCheck-2.8.2/changelog 2016-01-15 17:09:16.000000000 +0100 +++ new/QuickCheck-2.9.2/changelog 2016-09-15 12:03:42.000000000 +0200 @@ -1,3 +1,26 @@ +QuickCheck 2.9.2 (released 2016-09-15) + * Fix a bug where some properties were only being tested once + * Make shrinking of floating-point values less aggressive + * Add function chooseAny :: Random a => Gen a + +QuickCheck 2.9.1 (released 2016-07-11) + * 'again' was only used in forAllShrink, not forAll + +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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/QuickCheck-2.8.2/tests/GCoArbitraryExample.hs new/QuickCheck-2.9.2/tests/GCoArbitraryExample.hs --- old/QuickCheck-2.8.2/tests/GCoArbitraryExample.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/QuickCheck-2.9.2/tests/GCoArbitraryExample.hs 2016-09-15 12:03:42.000000000 +0200 @@ -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] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/QuickCheck-2.8.2/tests/GShrinkExample.hs new/QuickCheck-2.9.2/tests/GShrinkExample.hs --- old/QuickCheck-2.8.2/tests/GShrinkExample.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/QuickCheck-2.9.2/tests/GShrinkExample.hs 2016-09-15 12:03:42.000000000 +0200 @@ -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] == [[]] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/QuickCheck-2.8.2/tests/Generators.hs new/QuickCheck-2.9.2/tests/Generators.hs --- old/QuickCheck-2.8.2/tests/Generators.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/QuickCheck-2.9.2/tests/Generators.hs 2016-09-15 12:03:42.000000000 +0200 @@ -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
