Hello community,
here is the log from the commit of package ghc-QuickCheck for openSUSE:Factory
checked in at 2019-04-03 09:27:00
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-QuickCheck (Old)
and /work/SRC/openSUSE:Factory/.ghc-QuickCheck.new.25356 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-QuickCheck"
Wed Apr 3 09:27:00 2019 rev:16 rq:690177 version:2.13.1
Changes:
--------
--- /work/SRC/openSUSE:Factory/ghc-QuickCheck/ghc-QuickCheck.changes
2018-10-25 08:18:33.896012332 +0200
+++ /work/SRC/openSUSE:Factory/.ghc-QuickCheck.new.25356/ghc-QuickCheck.changes
2019-04-03 09:27:05.983789371 +0200
@@ -1,0 +2,27 @@
+Sat Mar 30 19:21:39 UTC 2019 - psim...@suse.com
+
+- Update QuickCheck to version 2.13.1.
+ QuickCheck 2.13.1 (release 2019-03-29)
+ * A couple of bug fixes
+
+ 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
+
+-------------------------------------------------------------------
Old:
----
QuickCheck-2.12.6.1.tar.gz
New:
----
QuickCheck-2.13.1.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-QuickCheck.spec ++++++
--- /var/tmp/diff_new_pack.2GQHns/_old 2019-04-03 09:27:07.551790109 +0200
+++ /var/tmp/diff_new_pack.2GQHns/_new 2019-04-03 09:27:07.571790118 +0200
@@ -1,7 +1,7 @@
#
# spec file for package ghc-QuickCheck
#
-# Copyright (c) 2018 SUSE LINUX GmbH, Nuernberg, Germany.
+# Copyright (c) 2019 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,7 +19,7 @@
%global pkg_name QuickCheck
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 2.12.6.1
+Version: 2.13.1
Release: 0
Summary: Automatic testing of Haskell programs
License: BSD-3-Clause
@@ -29,11 +29,10 @@
BuildRequires: ghc-Cabal-devel
BuildRequires: ghc-containers-devel
BuildRequires: ghc-deepseq-devel
-BuildRequires: ghc-erf-devel
BuildRequires: ghc-random-devel
BuildRequires: ghc-rpm-macros
+BuildRequires: ghc-splitmix-devel
BuildRequires: ghc-template-haskell-devel
-BuildRequires: ghc-tf-random-devel
BuildRequires: ghc-transformers-devel
%if %{with tests}
BuildRequires: ghc-process-devel
@@ -60,7 +59,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
+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.
++++++ QuickCheck-2.12.6.1.tar.gz -> QuickCheck-2.13.1.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/QuickCheck-2.12.6.1/LICENSE
new/QuickCheck-2.13.1/LICENSE
--- old/QuickCheck-2.12.6.1/LICENSE 1970-01-01 01:00:00.000000000 +0100
+++ new/QuickCheck-2.13.1/LICENSE 2019-03-27 08:33:34.000000000 +0100
@@ -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:
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/QuickCheck-2.12.6.1/QuickCheck.cabal
new/QuickCheck-2.13.1/QuickCheck.cabal
--- old/QuickCheck-2.12.6.1/QuickCheck.cabal 1970-01-01 01:00:00.000000000
+0100
+++ new/QuickCheck-2.13.1/QuickCheck.cabal 2019-03-29 06:56:48.000000000
+0100
@@ -1,10 +1,10 @@
Name: QuickCheck
-Version: 2.12.6.1
+Version: 2.13.1
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 <k...@chalmers.se>
Maintainer: Nick Smallbone <n...@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.1
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,19 @@
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
+
+Test-Suite test-quickcheck-misc
+ type: exitcode-stdio-1.0
+ hs-source-dirs: tests
+ main-is: Misc.hs
+ build-depends: base, QuickCheck
+ if !flag(templateHaskell) || !impl(ghc >= 7.10)
buildable: False
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/QuickCheck-2.12.6.1/README
new/QuickCheck-2.13.1/README
--- old/QuickCheck-2.12.6.1/README 1970-01-01 01:00:00.000000000 +0100
+++ new/QuickCheck-2.13.1/README 2019-03-28 13:31:22.000000000 +0100
@@ -7,4 +7,7 @@
The quickcheck-instances [1] companion package provides instances for types in
Haskell Platform packages at the cost of additional dependencies.
+The make-hugs script makes a Hugs-compatible version of QuickCheck.
+It may also be useful for other non-GHC implementations.
+
[1]: http://hackage.haskell.org/package/quickcheck-instances
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/QuickCheck-2.12.6.1/Test/QuickCheck/Exception.hs
new/QuickCheck-2.13.1/Test/QuickCheck/Exception.hs
--- old/QuickCheck-2.12.6.1/Test/QuickCheck/Exception.hs 1970-01-01
01:00:00.000000000 +0100
+++ new/QuickCheck-2.13.1/Test/QuickCheck/Exception.hs 2019-03-27
08:35:06.000000000 +0100
@@ -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
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/QuickCheck-2.12.6.1/Test/QuickCheck/Features.hs
new/QuickCheck-2.13.1/Test/QuickCheck/Features.hs
--- old/QuickCheck-2.12.6.1/Test/QuickCheck/Features.hs 1970-01-01
01:00:00.000000000 +0100
+++ new/QuickCheck-2.13.1/Test/QuickCheck/Features.hs 2018-11-17
21:28:13.000000000 +0100
@@ -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')
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/QuickCheck-2.12.6.1/Test/QuickCheck/Function.hs
new/QuickCheck-2.13.1/Test/QuickCheck/Function.hs
--- old/QuickCheck-2.12.6.1/Test/QuickCheck/Function.hs 1970-01-01
01:00:00.000000000 +0100
+++ new/QuickCheck-2.13.1/Test/QuickCheck/Function.hs 2019-01-19
22:22:47.000000000 +0100
@@ -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@,
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/QuickCheck-2.12.6.1/Test/QuickCheck/Gen.hs
new/QuickCheck-2.13.1/Test/QuickCheck/Gen.hs
--- old/QuickCheck-2.12.6.1/Test/QuickCheck/Gen.hs 1970-01-01
01:00:00.000000000 +0100
+++ new/QuickCheck-2.13.1/Test/QuickCheck/Gen.hs 2019-03-27
08:42:06.000000000 +0100
@@ -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.
--
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/QuickCheck-2.12.6.1/Test/QuickCheck/Modifiers.hs
new/QuickCheck-2.13.1/Test/QuickCheck/Modifiers.hs
--- old/QuickCheck-2.12.6.1/Test/QuickCheck/Modifiers.hs 1970-01-01
01:00:00.000000000 +0100
+++ new/QuickCheck-2.13.1/Test/QuickCheck/Modifiers.hs 2019-03-27
08:42:06.000000000 +0100
@@ -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,15 +264,27 @@
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
-
- shrink (Positive x) =
- [ Positive x'
- | x' <- shrink x
- , x' > 0
- ]
+ arbitrary = fmap Positive (fmap abs arbitrary `suchThat` (> 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@.
@@ -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
-
- shrink (NonNegative x) =
- [ NonNegative x'
- | x' <- shrink x
- , x' >= 0
- ]
+ arbitrary = fmap NonNegative (fmap abs arbitrary `suchThat` (>= 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
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/QuickCheck-2.12.6.1/Test/QuickCheck/Property.hs
new/QuickCheck-2.13.1/Test/QuickCheck/Property.hs
--- old/QuickCheck-2.12.6.1/Test/QuickCheck/Property.hs 1970-01-01
01:00:00.000000000 +0100
+++ new/QuickCheck-2.13.1/Test/QuickCheck/Property.hs 2019-03-28
13:31:33.000000000 +0100
@@ -94,6 +94,16 @@
-- | Convert the thing to a property.
property :: prop -> Property
+ -- | Optional; used internally in order to improve shrinking.
+ -- Tests a property but also quantifies over an extra value
+ -- (with a custom shrink and show function).
+ -- The 'Testable' instance for functions defines
+ -- @propertyForAllShrinkShow@ in a way that improves shrinking.
+ propertyForAllShrinkShow :: Gen a -> (a -> [a]) -> (a -> [String]) -> (a ->
prop) -> Property
+ propertyForAllShrinkShow gen shr shw f =
+ forAllShrinkBlind gen shr $
+ \x -> foldr counterexample (property (f x)) (shw x)
+
-- | If a property returns 'Discard', the current test case is discarded,
-- the same as if a precondition was false.
--
@@ -115,6 +125,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
@@ -122,13 +139,13 @@
property = MkProperty . return . MkProp . protectResults . return
instance Testable Prop where
- property (MkProp r) = MkProperty . return . MkProp . ioRose . return $ r
+ property p = MkProperty . return . protectProp $ p
instance Testable prop => Testable (Gen prop) where
property mp = MkProperty $ do p <- mp; unProperty (again p)
instance Testable Property where
- property (MkProperty mp) = MkProperty $ do p <- mp; unProperty (property p)
+ property (MkProperty mp) = MkProperty (fmap protectProp mp)
-- | Do I/O inside a property.
{-# DEPRECATED morallyDubiousIOProperty "Use 'ioProperty' instead" #-}
@@ -157,7 +174,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 (return . 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 ++ [show y])
+ (uncurry f)
-- ** Exception handling
protect :: (AnException -> a) -> IO a -> IO a
@@ -216,6 +242,10 @@
protectRose :: IO (Rose Result) -> IO (Rose Result)
protectRose = protect (return . exception "Exception")
+-- | Wrap the top level of a 'Prop' in an exception handler.
+protectProp :: Prop -> Prop
+protectProp (MkProp r) = MkProp (IORose . protectRose . return $ r)
+
-- | Wrap all the Results in a rose tree in exception handlers.
protectResults :: Rose Result -> Rose Result
protectResults = onRose $ \x rs ->
@@ -305,7 +335,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 +535,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 +585,9 @@
-> prop -> Property
classify False _ = property
classify True s =
+#ifndef NO_DEEPSEQ
s `deepseq`
+#endif
mapTotalResult $
\res -> res { classes = s:classes res }
@@ -654,7 +688,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 +740,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
@@ -721,6 +759,16 @@
-- | Considers a property failed if it does not complete within
-- the given number of microseconds.
+--
+-- Note: if the property times out, variables quantified inside the
+-- `within` will not be printed. Therefore, you should use `within`
+-- only in the body of your property.
+--
+-- Good: @prop_foo a b c = within 1000000 ...@
+--
+-- Bad: @prop_foo = within 1000000 $ \\a b c -> ...@
+--
+-- Bad: @prop_foo a b c = ...; main = quickCheck (within 1000000 prop_foo)@
within :: Testable prop => Int -> prop -> Property
within n = mapRoseResult f
where
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/QuickCheck-2.12.6.1/Test/QuickCheck/Random.hs
new/QuickCheck-2.13.1/Test/QuickCheck/Random.hs
--- old/QuickCheck-2.12.6.1/Test/QuickCheck/Random.hs 1970-01-01
01:00:00.000000000 +0100
+++ new/QuickCheck-2.13.1/Test/QuickCheck/Random.hs 2019-03-27
08:42:06.000000000 +0100
@@ -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
+
+-- Parameterised in order to make this code testable.
+class Splittable a where
+ left, right :: a -> a
+
+instance Splittable QCGen where
+ left = fst . split
+ right = snd . split
+
+-- 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
+
+ encode (-1) g = g
+ encode k g
+ | testBit n k =
+ encode (k-1) $! right g
+ | otherwise =
+ encode (k-1) $! left g
-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
-
-{-# 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
-
-{-# 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)
-
-boolVariant :: Bool -> TheGen -> TheGen
-boolVariant False = fst . split
-boolVariant True = snd . split
+ zeroes 0 g = g
+ zeroes k g = zeroes (k-1) $! left g
-variantQCGen :: Integral a => a -> QCGen -> QCGen
-variantQCGen n (QCGen g) = QCGen (variantTheGen n g)
+ ilog2 1 = 0
+ ilog2 n = 1 + ilog2 (n `div` 2)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/QuickCheck-2.12.6.1/Test/QuickCheck/Test.hs
new/QuickCheck-2.13.1/Test/QuickCheck/Test.hs
--- old/QuickCheck-2.12.6.1/Test/QuickCheck/Test.hs 1970-01-01
01:00:00.000000000 +0100
+++ new/QuickCheck-2.13.1/Test/QuickCheck/Test.hs 2019-03-27
08:42:06.000000000 +0100
@@ -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)]
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/QuickCheck-2.12.6.1/Test/QuickCheck/Text.hs
new/QuickCheck-2.13.1/Test/QuickCheck/Text.hs
--- old/QuickCheck-2.12.6.1/Test/QuickCheck/Text.hs 1970-01-01
01:00:00.000000000 +0100
+++ new/QuickCheck-2.13.1/Test/QuickCheck/Text.hs 2018-11-17
21:20:32.000000000 +0100
@@ -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:
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/QuickCheck-2.12.6.1/Test/QuickCheck.hs
new/QuickCheck-2.13.1/Test/QuickCheck.hs
--- old/QuickCheck-2.12.6.1/Test/QuickCheck.hs 1970-01-01 01:00:00.000000000
+0100
+++ new/QuickCheck-2.13.1/Test/QuickCheck.hs 2019-03-22 16:01:07.000000000
+0100
@@ -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
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/QuickCheck-2.12.6.1/changelog
new/QuickCheck-2.13.1/changelog
--- old/QuickCheck-2.12.6.1/changelog 1970-01-01 01:00:00.000000000 +0100
+++ new/QuickCheck-2.13.1/changelog 2019-03-29 06:20:20.000000000 +0100
@@ -1,3 +1,26 @@
+QuickCheck 2.13.1 (release 2019-03-29)
+ * A couple of bug fixes
+
+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 :)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/QuickCheck-2.12.6.1/make-hugs
new/QuickCheck-2.13.1/make-hugs
--- old/QuickCheck-2.12.6.1/make-hugs 1970-01-01 01:00:00.000000000 +0100
+++ new/QuickCheck-2.13.1/make-hugs 2019-03-27 08:33:34.000000000 +0100
@@ -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."
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/QuickCheck-2.12.6.1/tests/Generators.hs
new/QuickCheck-2.13.1/tests/Generators.hs
--- old/QuickCheck-2.12.6.1/tests/Generators.hs 1970-01-01 01:00:00.000000000
+0100
+++ new/QuickCheck-2.13.1/tests/Generators.hs 2019-03-22 16:01:07.000000000
+0100
@@ -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))
-
-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)
+ 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_nonnegative = pathInt getNonNegative (>= 0)
-prop_nonnegative_bound = somePathInt getNonNegative (== 0)
+prop_positive = pathInt True getPositive (> 0)
+prop_positive_bound = somePathInt True getPositive (== 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 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
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/QuickCheck-2.12.6.1/tests/Misc.hs
new/QuickCheck-2.13.1/tests/Misc.hs
--- old/QuickCheck-2.12.6.1/tests/Misc.hs 1970-01-01 01:00:00.000000000
+0100
+++ new/QuickCheck-2.13.1/tests/Misc.hs 2019-03-28 13:31:33.000000000 +0100
@@ -0,0 +1,26 @@
+-- Miscellaneous tests.
+
+{-# LANGUAGE TemplateHaskell #-}
+import Test.QuickCheck
+import Test.QuickCheck.Random
+
+prop_verbose :: Blind (Int -> Int -> Bool) -> Property
+prop_verbose (Blind p) =
+ forAll (mkQCGen <$> arbitrary) $ \g ->
+ ioProperty $ do
+ res1 <- quickCheckWithResult stdArgs{replay = Just (g, 100), chatty =
False} p
+ res2 <- quickCheckWithResult stdArgs{replay = Just (g, 100), chatty =
False} (verbose p)
+ return $
+ numTests res1 === numTests res2 .&&.
+ failingTestCase res1 === failingTestCase res2
+
+prop_failingTestCase :: Blind (Int -> Int -> Int -> Bool) -> Property
+prop_failingTestCase (Blind p) = ioProperty $ do
+ res <- quickCheckWithResult stdArgs{chatty = False} p
+ let [x, y, z] = failingTestCase res
+ return (not (p (read x) (read y) (read z)))
+
+return []
+main = do
+ True <- $quickCheckAll
+ return ()
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/QuickCheck-2.12.6.1/tests/Split.hs
new/QuickCheck-2.13.1/tests/Split.hs
--- old/QuickCheck-2.12.6.1/tests/Split.hs 1970-01-01 01:00:00.000000000
+0100
+++ new/QuickCheck-2.13.1/tests/Split.hs 2019-03-27 08:42:06.000000000
+0100
@@ -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 ()
