QuickCheck 2.15 → 2.18.0.0
raw patch · 35 files changed
Files
- QuickCheck.cabal +69/−63
- changelog +0/−424
- changelog.md +457/−0
- examples/Heap.hs +2/−2
- examples/Heap_Program.hs +1/−1
- examples/Heap_ProgramAlgebraic.hs +1/−1
- examples/Merge.hs +1/−1
- examples/Set.hs +1/−1
- examples/Simple.hs +1/−1
- make-hugs +1/−0
- src/Test/QuickCheck.hs +19/−9
- src/Test/QuickCheck/All.hs +1/−0
- src/Test/QuickCheck/Arbitrary.hs +369/−55
- src/Test/QuickCheck/Compat.hs +34/−0
- src/Test/QuickCheck/Exception.hs +2/−2
- src/Test/QuickCheck/Features.hs +21/−23
- src/Test/QuickCheck/Function.hs +144/−6
- src/Test/QuickCheck/Gen.hs +3/−4
- src/Test/QuickCheck/Modifiers.hs +31/−13
- src/Test/QuickCheck/Monadic.hs +0/−7
- src/Test/QuickCheck/Monoids.hs +83/−0
- src/Test/QuickCheck/Property.hs +51/−11
- src/Test/QuickCheck/Random.hs +23/−8
- src/Test/QuickCheck/State.hs +32/−18
- src/Test/QuickCheck/Test.hs +31/−28
- test-mhs +25/−0
- tests/CollectDataTypes.hs +199/−0
- tests/DiscardRatio.hs +5/−0
- tests/GCoArbitraryExample.hs +1/−1
- tests/Generators.hs +2/−2
- tests/Misc.hs +1/−1
- tests/Monoids.hs +146/−0
- tests/RunCollectDataTypes.hs +89/−0
- tests/Terminal.hs +1/−1
- tests/WithProgress.hs +68/−0
QuickCheck.cabal view
@@ -1,5 +1,5 @@ Name: QuickCheck-Version: 2.15+Version: 2.18.0.0 Cabal-Version: >= 1.10 Build-type: Simple License: BSD3@@ -8,15 +8,7 @@ Author: Koen Claessen <koen@chalmers.se> Maintainer: Nick Smallbone <nick@smallbone.se> Bug-reports: https://github.com/nick8325/quickcheck/issues-Tested-with: GHC == 7.0.4 ||- == 7.2.2 ||- == 7.4.1 ||- == 7.4.2 ||- == 7.6.3 ||- == 7.8.4 ||- == 7.10.3 ||- == 8.0.2 ||- >= 8.2.2 && < 9.10+Tested-with: GHC >= 8.10 && < 9.15, hugs Homepage: https://github.com/nick8325/quickcheck Category: Testing Synopsis: Automatic testing of Haskell programs@@ -47,7 +39,7 @@ extra-source-files: README- changelog+ changelog.md examples/Heap.hs examples/Heap_Program.hs examples/Heap_ProgramAlgebraic.hs@@ -57,6 +49,7 @@ examples/Simple.hs make-hugs test-hugs+ test-mhs source-repository head type: git@@ -65,7 +58,7 @@ source-repository this type: git location: https://github.com/nick8325/quickcheck- tag: 2.15+ tag: 2.18 flag templateHaskell Description: Build Test.QuickCheck.All, which uses Template Haskell.@@ -79,7 +72,7 @@ library Hs-source-dirs: src- Build-depends: base >=4.3 && <5, containers+ Build-depends: base >=4.14 && <5, containers Default-language: Haskell2010 -- New vs old random.@@ -87,7 +80,7 @@ Build-depends: random >= 1.0.0.3 && < 1.2.0 cpp-options: -DOLD_RANDOM else- Build-depends: random >= 1.2.0 && < 1.3+ Build-depends: random >= 1.2.0 && < 1.4 -- We always use splitmix directly rather than going through StdGen -- (it's somewhat more efficient).@@ -98,13 +91,18 @@ else Build-depends: splitmix >= 0.1.0.2 && <0.2 + if impl(hugs)+ cpp-options: -DNO_SEMIGROUP -DNO_EXISTENTIAL_FIELD_SELECTORS+ -- Modules that are always built. Exposed-Modules: Test.QuickCheck,+ Test.QuickCheck.Compat, Test.QuickCheck.Arbitrary, Test.QuickCheck.Gen, Test.QuickCheck.Gen.Unsafe, Test.QuickCheck.Monadic,+ Test.QuickCheck.Monoids, Test.QuickCheck.Modifiers, Test.QuickCheck.Property, Test.QuickCheck.Test,@@ -116,57 +114,41 @@ Test.QuickCheck.Features -- GHC-specific modules.- if impl(ghc)+ if impl(ghc) || impl(mhs) Exposed-Modules: Test.QuickCheck.Function Build-depends: transformers >= 0.3, deepseq >= 1.1.0.0- else- cpp-options: -DNO_TRANSFORMERS -DNO_DEEPSEQ if impl(ghc) && flag(templateHaskell) Build-depends: template-haskell >= 2.4- if impl(ghc >=8.0)- Other-Extensions: TemplateHaskellQuotes- else- Other-Extensions: TemplateHaskell+ Other-Extensions: TemplateHaskellQuotes Exposed-Modules: Test.QuickCheck.All else cpp-options: -DNO_TEMPLATE_HASKELL - if !impl(ghc >= 8.0)+ if !impl(ghc) && !impl(mhs) cpp-options: -DNO_CALLSTACK-- if !impl(ghc >= 7.4)- cpp-options: -DNO_CTYPES_CONSTRUCTORS -DNO_FOREIGN_C_USECONDS-- -- The new generics appeared in GHC 7.2...- if impl(ghc < 7.2)- cpp-options: -DNO_GENERICS- -- ...but in 7.2-7.4 it lives in the ghc-prim package.- if impl(ghc >= 7.2) && impl(ghc < 7.6)- Build-depends: ghc-prim-- -- Safe Haskell appeared in GHC 7.2, but GHC.Generics isn't safe until 7.4.- if impl (ghc < 7.4)- cpp-options: -DNO_SAFE_HASKELL+ -DNO_SEMIGROUP+ -DNO_CTYPES_CONSTRUCTORS+ -DNO_FOREIGN_C_USECONDS+ -DNO_POLYKINDS+ -DNO_MONADFAIL+ -DNO_TRANSFORMERS+ -DNO_DEEPSEQ -- random is explicitly Trustworthy since 1.0.1.0 -- similar constraint for containers- if impl(ghc >= 7.2)+ if impl(ghc) Build-depends: random >=1.0.1.0- if impl(ghc >= 7.4)- Build-depends: containers >=0.4.2.1-- if !impl(ghc >= 7.6)- cpp-options: -DNO_POLYKINDS-- if !impl(ghc >= 8.0)- cpp-options: -DNO_MONADFAIL+ , containers >=0.4.2.1 if impl(ghc >= 9.8) ghc-options: -Wno-x-partial + if impl(ghc < 9.4)+ Build-depends: data-array-byte+ -- Switch off most optional features on non-GHC systems.- if !impl(ghc)+ if !impl(ghc) && !impl(mhs) -- 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@@ -175,17 +157,14 @@ if !impl(hugs) && !impl(uhc) cpp-options: -DNO_ST_MONAD -DNO_MULTI_PARAM_TYPE_CLASSES + if impl(mhs)+ cpp-options: -DNO_GENERICS -DNO_TEMPLATE_HASKELL -DNO_CTYPES_CONSTRUCTORS+ -DNO_EXISTENTIAL_FIELD_SELECTORS+ -- LANGUAGE pragmas don't have any effect in Hugs. if impl(hugs) Default-Extensions: CPP - if impl(uhc)- -- Cabal under UHC needs pointing out all the dependencies of the- -- random package.- Build-depends: old-time, old-locale- -- Plus some bits of the standard library are missing.- cpp-options: -DNO_FIXED -DNO_EXCEPTIONS- Test-Suite test-quickcheck type: exitcode-stdio-1.0 Default-language: Haskell2010@@ -202,10 +181,8 @@ hs-source-dirs: tests main-is: GCoArbitraryExample.hs build-depends: base, QuickCheck- if !flag(templateHaskell) || !impl(ghc >= 7.2)+ if !flag(templateHaskell) 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@@ -222,10 +199,8 @@ hs-source-dirs: tests main-is: GShrinkExample.hs build-depends: base, QuickCheck- if !flag(templateHaskell) || !impl(ghc >= 7.2)+ if !flag(templateHaskell) buildable: False- if impl(ghc >= 7.2) && impl(ghc < 7.6)- build-depends: ghc-prim Test-Suite test-quickcheck-terminal type: exitcode-stdio-1.0@@ -233,7 +208,7 @@ hs-source-dirs: tests main-is: Terminal.hs build-depends: base, process, deepseq >= 1.1.0.0, QuickCheck- if !flag(templateHaskell) || !impl(ghc >= 7.10)+ if !flag(templateHaskell) buildable: False Test-Suite test-quickcheck-monadfix@@ -242,7 +217,7 @@ hs-source-dirs: tests main-is: MonadFix.hs build-depends: base, QuickCheck- if !flag(templateHaskell) || !impl(ghc >= 7.10)+ if !flag(templateHaskell) buildable: False Test-Suite test-quickcheck-split@@ -260,7 +235,7 @@ hs-source-dirs: tests main-is: Strictness.hs build-depends: base, QuickCheck, containers- if !flag(templateHaskell) || !impl(ghc >= 7.10)+ if !flag(templateHaskell) buildable: False Test-Suite test-quickcheck-misc@@ -269,7 +244,7 @@ hs-source-dirs: tests main-is: Misc.hs build-depends: base, QuickCheck, containers- if !flag(templateHaskell) || !impl(ghc >= 7.10)+ if !flag(templateHaskell) buildable: False Test-Suite test-quickcheck-discard@@ -278,3 +253,34 @@ hs-source-dirs: tests main-is: DiscardRatio.hs build-depends: base, QuickCheck++Test-Suite test-quickcheck-monoids+ type: exitcode-stdio-1.0+ Default-language: Haskell2010+ hs-source-dirs: tests+ main-is: Monoids.hs+ build-depends: base, QuickCheck++Test-Suite test-quickcheck-withprogress+ type: exitcode-stdio-1.0+ Default-language: Haskell2010+ hs-source-dirs: tests+ main-is: WithProgress.hs+ build-depends: base, QuickCheck++Test-Suite test-quickcheck-instances+ type: exitcode-stdio-1.0+ Default-language: Haskell2010+ hs-source-dirs: tests+ other-modules: CollectDataTypes+ main-is: RunCollectDataTypes.hs+ build-depends:+ base,+ QuickCheck,+ transformers,+ split,+ process,+ template-haskell,+ hint+ if !flag(templateHaskell) || impl(ghc <= 8.10)+ buildable: False
− changelog
@@ -1,424 +0,0 @@-QuickCheck 2.15- * BREAKING: properties without quantification are no longer implicitly- wrapped in once- * Add witness property modifier and witnesses field in result on- compilers that support Typeable to allow conveniently exposing- counterexamples- * Add assertException, assertExceptionIO, assertDeepException, and- assertDeepExceptionIO (thanks to Alexey Kuleshevich)- * Add withMaxSize, withMaxShrinks, and withMaxDiscardRatio combinators- * Add recheck- * Add HasCallStack to partial top-level functions- * Updated some documentation- * Fix overflow bug when calculating discard ratio- * Fix error printing bug when shrinks are discarded- * Fix withMaxSuccess not working when checkCoverage is turned on- * Fix a bug whereby an unfortunately timed discard could unduly fail a- property running with checkCoverage- * Fix Arbitrary intance for Map breaking invariants from- Data.Map.Strict (thanks to Neil Mayhew)- * Fix non-covered classes not showing up in output as 0% covered- * Fix Negative's Arbitrary instance discarding an unnecessary number- of generated values.- * Fix promote doing an unnecessary seed split- * Fix a bug whereby maxSuccess and discardRatio would interact poorly- to produce too few size increases.- * Fix a couple of underflow bugs in generators for Small Natural and- Ratio Natural- * Fix a bug whereby the internal DISCARDED exception would show up- user-side in sample--QuickCheck 2.14.3 (released 2023-05-31)- * Add shrinkBoundedEnum (thanks to Jonathan Knowles)- * Add discardAfter for discarding tests on timeout (thanks to Justus Sagemüller)- * Add assertWith for monadic testing (thanks to KtorZ)- * Add functionElements to Test.QuickCheck.Function (thanks to Oleg Grenrus)- * Add Arbitrary instance for Newline (thanks to Daniel Bramucci)- * Improve Arbitrary instances for Float and Double (thanks to Oleg Grenrus)- * Improve arbitrarySizedFractional (thanks to Bodigrim)- * Fix shrinkRealFrac and shrinkDecimal, which were broken- * Speed up printing of progress messages (thanks to Bodigrim)- * Add COMPLETE pragmas for Fn and family (thanks to ilkecan)- * Make templateHaskell flag manual (thanks to Oleg Grenrus)--QuickCheck 2.14.2 (released 2020-11-14)- * Add Arbitrary instances for Tree (thanks to Oleg Grenrus)- * GHC 9.0 compatibility (thanks to Vilem-Benjamin Liepelt)--QuickCheck 2.14.1 (released 2020-07-05)- * Compatibility with random >= 1.2.--QuickCheck 2.14 (released 2020-03-28)- * QuickCheck is now much faster at generating test data!- As a result, many properties can now be tested a lot faster;- the examples distributed with QuickCheck run about twice as- fast as before, for example. Of course, your mileage may vary.-- The reason for this is that there are now specialised versions- of the 'choose' combinator for various types. These are:- chooseInt, chooseInteger, chooseBoundedIntegral, and chooseEnum.- These combinators are identical to 'choose' but much faster.- All QuickCheck combinators, with the exception of 'choose'- itself, use the new combinators behind the scenes.-- You should see a speedup without doing anything, but to get a- further speedup, consider replacing any uses of 'choose' in your- own generators with the new combinators.-- We are hoping that future releases of the 'random' library may- speed up 'choose', in which case these combinators may no longer- be needed.-- Thanks to Oleg Grenrus for suggesting to bypass 'choose' for- random number generation, and providing the appropriate- primitive in his 'splitmix' random number library.-- * Smaller changes and bugfixes:- - RecursivelyShrink and GSubterms are exported from- Test.QuickCheck.Test (thanks to Tom Mortiboy).- - Don't generate invalid unicode characters- (thanks to Boris Stepanov).- - When a call to 'within' fails, include the duration of the- timeout in the failure report (thanks to William Rusnack).- - In Gen, avoid splitting the seed in the implementation of- >>, *> and <* (thanks to David Feuer).- - Fix a couple of bugs with shrinking of floating-point- numbers.- - Export functionMapWith, functionEitherWith and- functionPairWith from Test.QuickCheck.Function- (thanks to Oleg Grenrus).- - Remove redundant RealFloat constraint from- Arbitrary/CoArbitrary instances for Complex- (thanks to Bodigrim).--QuickCheck 2.13.2 (released 2019-06-30)- * Compatibility with GHC 8.8 (thanks to Bodigrim)- * Improve error message when 'frequency' is used with only zero weights- * Add 'functionVoid' combinator (thanks to Oleg Grenrus)- * Tighten bounds for random package (thanks to Oleg Grenrus)--QuickCheck 2.13.1 (released 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 :)--QuickCheck 2.12.5 (released 2018-09-30)- * Export isSuccess from Test.QuickCheck.- * Export CoArbitrary even when generics are disabled (bugfix).- * Fix bug in shrinkDecimal.- * Include Test.QuickCheck.Gen in exposed modules for Haddock.--QuickCheck 2.12.3, 2.12.4 (released 2018-09-12)- * Shrinking for Float and Decimal now works by reducing the number- of digits in the number. The new function shrinkDecimal- implements this shrinking behaviour.- * Shrinking for Rational now tries to make the numerator and- denominator of the number smaller. Previously it tried to reduce- the magnitude of the number.--QuickCheck 2.12.2 (released 2018-09-10)- * Fix infinite shrinking loop for fractional types.- * Add SortedList modifier.--QuickCheck 2.12.1 (released 2018-09-06)- * Fix bug in 'classify'.--QuickCheck 2.12 (released 2018-09-03)- * Silently breaking changes!- - The Arbitrary instance for Word now generates only small- values, the same as Int- - cover no longer causes a property failure if coverage is- insufficient. It just prints a warning. (But see next item!)-- * Overhaul of label/cover family of combinators:- - New property combinator checkCoverage, which checks coverage- requirements in a statistically sound way, and *does* fail if- they are not met.- - Order of arguments to cover swapped, to make it easier to- switch between classify and cover- - New combinators tabulate and coverTable, for reporting test- case distribution more flexibly than label.- - When label is called multiple times in a property, each call- produces a separate table of frequencies.-- * New functions:- - (=/=): like (/=), but prints a counterexample- (thanks to tom-bop)- - forAllShow/forAllShrinkShow: quantification using an- explicit show function (thanks to Stevan Andjelkovic)- - forAllBlind/forAllShrinkBlind: quantification without- printing anything- - verboseShrinking: see how a counterexample is shrunk- - labelledExamples: given a property which uses label,- generate an example test case for each label- - idempotentIOProperty: a variant of ioProperty which shrinks- better but only works for idempotent I/O actions-- * Other improvements:- - MonadFix Gen instance (thanks to Jon Fowler)- - Rational numbers shrink using continued fractions- (thanks to Justus Sagemüller)- - Function instances for Const, Identity, and the types in- Data.Monoid; instance Functor Fun (thanks to Erik Schnetter- and Xia Li-yao)- - More of Test.QuickCheck.Function is exported from- Test.QuickCheck- - Semantics of .||. changed to improve short-circuiting:- if the left argument's precondition is false, the right- argument is not evaluated and the whole disjunction is- considered to have a false precondition- - Bug fix: suchThatMaybe always increased size to at least 1-- * Miscellaneous API changes:- - Result type has changed a bit:- - InsufficientCovered constructor is gone- - Type of labels has changed- - New fields classes, tables--QuickCheck 2.11.1 - 2.11.3 (released 2018-01-12)- * Cosmetic fixes.--QuickCheck 2.11 (released 2018-01-12)- * New features:- - InfiniteList modifier generates infinite lists and shows- only the relevant part.- - applyArbitrary2/3/4 for applying a function to random- arguments.- - Template Haskell function allProperties returns all- properties in a module.-- * Applicative Gen instances do less splitting.- * Property now has a Typeable instance.- * (===) now prints correct output when the property is true.- * Test.QuickCheck now exports Fun constructor.- * verboseCheck output is now slightly less confusing.--QuickCheck 2.10.1 (released 2017-10-06)- * Arbitrary instances for Foreign.C.Types are available in more- GHC versions.- * Fixed a bug where withMaxSuccess didn't adjust the allowed- number of discarded tests.- * Remove quadratic behaviour in terminal output.--QuickCheck 2.10 (released 2017-06-15)- * New combinators:- - withMaxSuccess sets the maximum number of test cases for a property.- - shrinkMap/shrinkMapBy are helpers for defining shrink functions.- - total checks that a value is non-crashing.- - suchThatMap is similar to 'suchThat'- but takes a Maybe-returning function instead of a predicate.- - getSize returns the current test case size.-- * Random strings and characters now include Unicode characters by- default. To generate only ASCII characters, use the new- ASCIIString modifier or arbitraryASCIIChar generator.- The following modifiers and generators also control the- kind of strings generated: UnicodeString, PrintableString,- arbitraryUnicodeChar, arbitraryPrintableChar.-- * QuickCheck no longer catches asynchronous exceptions, which- means that pressing ctrl-C will now cancel testing without- printing a counterexample. If you are debugging an infinite loop,- please use the 'within' combinator or 'verboseCheck' instead.- ('within' is better as it allows the counterexample to be- shrunk.)-- * Much of Test.QuickCheck.Function (showable random functions)- is now exported from Test.QuickCheck.- - Test.QuickCheck.Function now defines functions and- pattern synonyms which simplify testing functions of- more than one argument: apply2, apply3, Fn2, Fn3.-- * New typeclasses Arbitrary1 and Arbitrary2 which lift Arbitrary- to unary/binary type constructors, like in Data.Functor.Classes.-- * Some Arbitrary instances have been removed: NonEmpty, Natural.- This is because they resulted in a lot of extra dependencies.- You can now find them in the quickcheck-instances package.- Alternatively, use the NonEmptyList and NonNegative modifiers.-- * New Arbitrary instances for the following types: Proxy, ExitCode,- WrappedMonad, WrappedArrow, QCGen, and the types in- Foreign.C.Types and Data.Functor.{Product,Compose}.- Also a Function instance for Word.-- * The functions in Test.QuickCheck.Monadic which take an argument- of type PropertyM m a now expect that 'a' to be Testable, and test it.- To reduce breakage from this, () is now an instance of Testable which- always succeeds.- - PropertyM now has a MonadFail instance on recent GHCs.- Furthermore, the constraints on some instances were loosened.-- * Miscellaneous API changes:- - Result now returns the counterexample as a list of strings.- See the "failingTestCase" field.- - Args now has a `maxShrinks` argument, the maximum number of- shrinks to try before giving up shrinking.- - The 'labels' field of Result now encodes frequencies as Doubles- rather than Ints.-- * Bugfixes:- - 'Test.QuickCheck.Function', 'Test.QuickCheck.Poly', and- 'Test.QuickCheck.Monadic' are now Safe modules.- - Result.theException and Result.reason were taken from- the pre-shrunk counterexample, not the shrunk one.- - The Testable Property instance improperly used 'again'.- - Gen.>>= is strict in the result of split, fixing a space leak.- - within now gives a better error message on timeout-- * Some more examples and links have been added to the documentation.--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- containers package- * Improve speed of shuffle combinator- * Only print to stderr if it's a terminal.- * Small changes: slightly improve documentation,- remove redundant constraints from some functions' types,- small improvements to Test.QuickCheck.All.--QuickCheck 2.8.1 (released 2015-04-03)- * Fix bug where exceptions thrown printing counterexamples weren't- being caught when terminal output was disabled- * Don't export Test.QuickCheck.Property.result--QuickCheck 2.8 (released 2015-03-18)- * New features:- * Support for GHC 7.10- * Arbitrary instance for Natural- * New generators shuffle and sublistOf- * Support for generic coarbitrary- * When using the cover combinator, insufficient coverage now- causes the property to fail-- * API changes:- * Test.QuickCheck.Function: new pattern synonym Fn- * genericShrink no longer requires Typeable- * Result has a new constructor InsufficientCoverage- * resize throws an error if the size is negative-- * Bug fixes:- * Fix memory leaks- * Exceptions thrown by callbacks now cause the test to fail- * Fixed a bug where the cover combinator wouldn't give a- warning if coverage was 0%--QuickCheck 2.7.3 (released 2014-03-24)- * Add annotations for Safe Haskell.--QuickCheck 2.7.2 (released 2014-03-22)- * Fix bug in cabal file which broke cabal test--QuickCheck 2.7.1 (released 2014-03-20)- * Fixed bug - the Small modifier didn't work on unsigned types- * Changed arbitrarySizedIntegral to have an Integral constraint- instead of just Num--QuickCheck 2.7 (released 2014-03-19)-- * New features:- * New genericShrink function provides generic shrinking with GHC.- * New combinator x === y: fails if x /= y, but also prints their values- * New function generate :: Gen a -> IO a for running a generator.- * New combinators infiniteList and infiniteListOf for generating infinite lists.- * Several combinators added to the main Test.QuickCheck module which- were previously languishing in other modules. Of particular interest:- quickCheckAll, ioProperty.- * New combinators delay and capture which can be used (unsafely!)- to reuse the random number seed. Useful for generating- polymorphic (rank-2) values.- * A new Discard data type and a Testable instance for discarding test cases.- * All modifiers now have Functor instances and accessor functions.- * Pressing ctrl-C during shrinking now shows the last failed- test case, rather than the current shrinking candidate.- * Experimental support for UHC. You will need the latest version of Cabal from git.-- * Better distribution of test data:- * The Int generator now only generates fairly small numbers.- * The new Small and Large modifiers control the distribution of integers- (Small generates small numbers, Large from the whole range).- * Floating-point numbers shrink better.-- * Improved random number generation:- * QuickCheck now uses TFGen rather than StdGen on newer versions- of GHC, because StdGen's random numbers aren't always random.- * 'variant' now uses a prefix code. This should prevent some- potential bananaskins with coarbitrary.-- * API changes:- * The Gen monad now uses an abstract type QCGen rather than StdGen.- * The Result type now returns the thrown exception and number- of failed shrink attempts.- * Property is now a newtype rather than Gen Prop as it was before.- * promote is moved into the new module Test.QuickCheck.Gen.Unsafe.- * 'printTestCase' is deprecated - its new name is 'counterexample'- * 'morallyDubiousIOProperty' is deprecated - its new name is- 'ioProperty', no moral judgement involved :)--QuickCheck 2.6, released 2013-03-07-- * Add convenience Function instances for up to 7-tuples- * Make stderr line buffered to reduce console I/O.- * Return a flag to say whether the test case was interrupted.--QuickCheck 2.5, released 2012-06-18-- * Replace maxDiscard with maxDiscardRatio- * Remove Testable () instance.- * Added a 'discard' exception that discards the current test case- * Add accessors for modifiers (where it makes sense)- * Rename 'stop' to 'abort' to avoid a name clash- * Added a 'once' combinator- * If a property is of type Bool, only run it once- * Add coarbitraryEnum to Test.QuickCheck module.- * Add 'coarbitrary' helper for Enums.- * Rejiggled the formatting code to support multi-line error messages- * Add instances for Ordering and Fixed.- * Added arbitraryBoundedEnum generator (thanks to Antoine Latter).- * Add verboseCheckAll and polyverboseCheck function for usability.
+ changelog.md view
@@ -0,0 +1,457 @@+## UNRELEASED++## QuickCheck 2.18.0.0 (released 2026-02-26)+* BREAKING: Added a number of `CoArbitrary` and `Function` instances for types in `base`+* Improve implementation of `shrinkIntegral` (thanks tom93)+* Improve implementation of `Arbitrary NonEmptyList` (thanks konsumlamm)+* Convert changelog to markdown (thanks Artem)+* Deprecate `withMaxSuccess` in favour of the renamed `withNumTests`+* `Test.QuickCheck.Function` marked as `Trustworthy` not `Safe`+* Fix bug in heap example++## QuickCheck 2.17.1.0 (released 2025-10-13)+* Fix random-1.2 support (thanks bodigrim)+* Update docs (thanks effectfully)++## QuickCheck 2.17.0.0 (released 2025-10-07)+* Lower the memory use of `arbitrary` for `Double` and `Float` (thanks+ChickenProp)+* BREAKING: Remove `Gen.Class`+* BREAKING: Add `Arbitrary` instances for most of the types in `base`+* Add microHS support (thanks Lennart)++## QuickCheck 2.16.0.0 (released 2025-06-17)+* Add a `Safe` declaration to `Test.QuickCheck.Monoids`+* Fix `Test.QuickCheck.Features` to not depend on the internal testing loop+* Add `withProgress` to install common callbacks for downstream tools+* Relax bounds on `random` dependency (thanks to LaurentRDC and+Andreas Abel)+* Fix some haddock issues (thanks to pgujjula)+* Use `displayException` instead of `show` (thanks Edsko)+* Added helper monoids `Every` and `Some` for predicates (thanks+Marcin)++## QuickCheck 2.15 (released 2024-04-22)+* BREAKING: properties without quantification are no longer implicitly+ wrapped in once+* Add witness property modifier and witnesses field in result on+compilers that support Typeable to allow conveniently exposing+counterexamples+* Add assertException, assertExceptionIO, assertDeepException, and+assertDeepExceptionIO (thanks to Alexey Kuleshevich)+* Add withMaxSize, withMaxShrinks, and withMaxDiscardRatio combinators+* Add recheck+* Add HasCallStack to partial top-level functions+* Updated some documentation+* Fix overflow bug when calculating discard ratio+* Fix error printing bug when shrinks are discarded+* Fix withMaxSuccess not working when checkCoverage is turned on+* Fix a bug whereby an unfortunately timed discard could unduly fail a+property running with checkCoverage+* Fix Arbitrary intance for Map breaking invariants from+Data.Map.Strict (thanks to Neil Mayhew)+* Fix non-covered classes not showing up in output as 0% covered+* Fix Negative's Arbitrary instance discarding an unnecessary number+of generated values.+* Fix promote doing an unnecessary seed split+* Fix a bug whereby maxSuccess and discardRatio would interact poorly+to produce too few size increases.+* Fix a couple of underflow bugs in generators for Small Natural and+Ratio Natural+* Fix a bug whereby the internal DISCARDED exception would show up+user-side in sample++## QuickCheck 2.14.3 (released 2023-05-31)+* Add shrinkBoundedEnum (thanks to Jonathan Knowles)+* Add discardAfter for discarding tests on timeout (thanks to Justus Sagemüller)+* Add assertWith for monadic testing (thanks to KtorZ)+* Add functionElements to Test.QuickCheck.Function (thanks to Oleg Grenrus)+* Add Arbitrary instance for Newline (thanks to Daniel Bramucci)+* Improve Arbitrary instances for Float and Double (thanks to Oleg Grenrus)+* Improve arbitrarySizedFractional (thanks to Bodigrim)+* Fix shrinkRealFrac and shrinkDecimal, which were broken+* Speed up printing of progress messages (thanks to Bodigrim)+* Add COMPLETE pragmas for Fn and family (thanks to ilkecan)+* Make templateHaskell flag manual (thanks to Oleg Grenrus)++## QuickCheck 2.14.2 (released 2020-11-14)+* Add Arbitrary instances for Tree (thanks to Oleg Grenrus)+* GHC 9.0 compatibility (thanks to Vilem-Benjamin Liepelt)++## QuickCheck 2.14.1 (released 2020-07-05)+* Compatibility with random >= 1.2.++## QuickCheck 2.14 (released 2020-03-28)+* QuickCheck is now much faster at generating test data!+ As a result, many properties can now be tested a lot faster;+ the examples distributed with QuickCheck run about twice as+ fast as before, for example. Of course, your mileage may vary.++ The reason for this is that there are now specialised versions+ of the 'choose' combinator for various types. These are:+ chooseInt, chooseInteger, chooseBoundedIntegral, and chooseEnum.+ These combinators are identical to 'choose' but much faster.+ All QuickCheck combinators, with the exception of 'choose'+ itself, use the new combinators behind the scenes.++ You should see a speedup without doing anything, but to get a+ further speedup, consider replacing any uses of 'choose' in your+ own generators with the new combinators.++ We are hoping that future releases of the 'random' library may+ speed up 'choose', in which case these combinators may no longer+ be needed.++ Thanks to Oleg Grenrus for suggesting to bypass 'choose' for+ random number generation, and providing the appropriate+ primitive in his 'splitmix' random number library.++* Smaller changes and bugfixes:+- RecursivelyShrink and GSubterms are exported from+ Test.QuickCheck.Test (thanks to Tom Mortiboy).+- Don't generate invalid unicode characters+ (thanks to Boris Stepanov).+- When a call to 'within' fails, include the duration of the+ timeout in the failure report (thanks to William Rusnack).+- In Gen, avoid splitting the seed in the implementation of+ >>, *> and <* (thanks to David Feuer).+- Fix a couple of bugs with shrinking of floating-point+ numbers.+- Export functionMapWith, functionEitherWith and+ functionPairWith from Test.QuickCheck.Function+ (thanks to Oleg Grenrus).+- Remove redundant RealFloat constraint from+ Arbitrary/CoArbitrary instances for Complex+ (thanks to Bodigrim).++## QuickCheck 2.13.2 (released 2019-06-30)+* Compatibility with GHC 8.8 (thanks to Bodigrim)+* Improve error message when 'frequency' is used with only zero weights+* Add 'functionVoid' combinator (thanks to Oleg Grenrus)+* Tighten bounds for random package (thanks to Oleg Grenrus)++## QuickCheck 2.13.1 (released 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 :)++## QuickCheck 2.12.5 (released 2018-09-30)+* Export isSuccess from Test.QuickCheck.+* Export CoArbitrary even when generics are disabled (bugfix).+* Fix bug in shrinkDecimal.+* Include Test.QuickCheck.Gen in exposed modules for Haddock.++## QuickCheck 2.12.3, 2.12.4 (released 2018-09-12)+* Shrinking for Float and Decimal now works by reducing the number+ of digits in the number. The new function shrinkDecimal+ implements this shrinking behaviour.+* Shrinking for Rational now tries to make the numerator and+ denominator of the number smaller. Previously it tried to reduce+ the magnitude of the number.++## QuickCheck 2.12.2 (released 2018-09-10)+* Fix infinite shrinking loop for fractional types.+* Add SortedList modifier.++## QuickCheck 2.12.1 (released 2018-09-06)+* Fix bug in 'classify'.++## QuickCheck 2.12 (released 2018-09-03)+* Silently breaking changes!+ - The Arbitrary instance for Word now generates only small+ values, the same as Int+ - cover no longer causes a property failure if coverage is+ insufficient. It just prints a warning. (But see next item!)++* Overhaul of label/cover family of combinators:+ - New property combinator checkCoverage, which checks coverage+ requirements in a statistically sound way, and *does* fail if+ they are not met.+ - Order of arguments to cover swapped, to make it easier to+ switch between classify and cover+ - New combinators tabulate and coverTable, for reporting test+ case distribution more flexibly than label.+ - When label is called multiple times in a property, each call+ produces a separate table of frequencies.++* New functions:+ - (=/=): like (/=), but prints a counterexample+ (thanks to tom-bop)+ - forAllShow/forAllShrinkShow: quantification using an+ explicit show function (thanks to Stevan Andjelkovic)+ - forAllBlind/forAllShrinkBlind: quantification without+ printing anything+ - verboseShrinking: see how a counterexample is shrunk+ - labelledExamples: given a property which uses label,+ generate an example test case for each label+ - idempotentIOProperty: a variant of ioProperty which shrinks+ better but only works for idempotent I/O actions++* Other improvements:+ - MonadFix Gen instance (thanks to Jon Fowler)+ - Rational numbers shrink using continued fractions+ (thanks to Justus Sagemüller)+ - Function instances for Const, Identity, and the types in+ Data.Monoid; instance Functor Fun (thanks to Erik Schnetter+ and Xia Li-yao)+ - More of Test.QuickCheck.Function is exported from+ Test.QuickCheck+ - Semantics of .||. changed to improve short-circuiting:+ if the left argument's precondition is false, the right+ argument is not evaluated and the whole disjunction is+ considered to have a false precondition+ - Bug fix: suchThatMaybe always increased size to at least 1++* Miscellaneous API changes:+ - Result type has changed a bit:+ - InsufficientCovered constructor is gone+ - Type of labels has changed+ - New fields classes, tables++## QuickCheck 2.11.1 - 2.11.3 (released 2018-01-12)+* Cosmetic fixes.++## QuickCheck 2.11 (released 2018-01-12)+* New features:+ - InfiniteList modifier generates infinite lists and shows+ only the relevant part.+ - applyArbitrary2/3/4 for applying a function to random+ arguments.+ - Template Haskell function allProperties returns all+ properties in a module.++* Applicative Gen instances do less splitting.+* Property now has a Typeable instance.+* (===) now prints correct output when the property is true.+* Test.QuickCheck now exports Fun constructor.+* verboseCheck output is now slightly less confusing.++## QuickCheck 2.10.1 (released 2017-10-06)+* Arbitrary instances for Foreign.C.Types are available in more+ GHC versions.+* Fixed a bug where withMaxSuccess didn't adjust the allowed+ number of discarded tests.+* Remove quadratic behaviour in terminal output.++## QuickCheck 2.10 (released 2017-06-15)+* New combinators:+ - withMaxSuccess sets the maximum number of test cases for a property.+ - shrinkMap/shrinkMapBy are helpers for defining shrink functions.+ - total checks that a value is non-crashing.+ - suchThatMap is similar to 'suchThat'+ but takes a Maybe-returning function instead of a predicate.+ - getSize returns the current test case size.++* Random strings and characters now include Unicode characters by+ default. To generate only ASCII characters, use the new+ ASCIIString modifier or arbitraryASCIIChar generator.+ The following modifiers and generators also control the+ kind of strings generated: UnicodeString, PrintableString,+ arbitraryUnicodeChar, arbitraryPrintableChar.++* QuickCheck no longer catches asynchronous exceptions, which+ means that pressing ctrl-C will now cancel testing without+ printing a counterexample. If you are debugging an infinite loop,+ please use the 'within' combinator or 'verboseCheck' instead.+ ('within' is better as it allows the counterexample to be+ shrunk.)++* Much of Test.QuickCheck.Function (showable random functions)+ is now exported from Test.QuickCheck.+ - Test.QuickCheck.Function now defines functions and+ pattern synonyms which simplify testing functions of+ more than one argument: apply2, apply3, Fn2, Fn3.++* New typeclasses Arbitrary1 and Arbitrary2 which lift Arbitrary+ to unary/binary type constructors, like in Data.Functor.Classes.++* Some Arbitrary instances have been removed: NonEmpty, Natural.+ This is because they resulted in a lot of extra dependencies.+ You can now find them in the quickcheck-instances package.+ Alternatively, use the NonEmptyList and NonNegative modifiers.++* New Arbitrary instances for the following types: Proxy, ExitCode,+ WrappedMonad, WrappedArrow, QCGen, and the types in+ Foreign.C.Types and Data.Functor.{Product,Compose}.+ Also a Function instance for Word.++* The functions in Test.QuickCheck.Monadic which take an argument+ of type PropertyM m a now expect that 'a' to be Testable, and test it.+ To reduce breakage from this, () is now an instance of Testable which+ always succeeds.+ - PropertyM now has a MonadFail instance on recent GHCs.+ Furthermore, the constraints on some instances were loosened.++* Miscellaneous API changes:+ - Result now returns the counterexample as a list of strings.+ See the "failingTestCase" field.+ - Args now has a `maxShrinks` argument, the maximum number of+ shrinks to try before giving up shrinking.+ - The 'labels' field of Result now encodes frequencies as Doubles+ rather than Ints.++* Bugfixes:+ - 'Test.QuickCheck.Function', 'Test.QuickCheck.Poly', and+ 'Test.QuickCheck.Monadic' are now Safe modules.+ - Result.theException and Result.reason were taken from+ the pre-shrunk counterexample, not the shrunk one.+ - The Testable Property instance improperly used 'again'.+ - Gen.>>= is strict in the result of split, fixing a space leak.+ - within now gives a better error message on timeout++* Some more examples and links have been added to the documentation.++## 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+ containers package+* Improve speed of shuffle combinator+* Only print to stderr if it's a terminal.+* Small changes: slightly improve documentation,+ remove redundant constraints from some functions' types,+ small improvements to Test.QuickCheck.All.++## QuickCheck 2.8.1 (released 2015-04-03)+* Fix bug where exceptions thrown printing counterexamples weren't+ being caught when terminal output was disabled+* Don't export Test.QuickCheck.Property.result++## QuickCheck 2.8 (released 2015-03-18)+* New features:+ * Support for GHC 7.10+ * Arbitrary instance for Natural+ * New generators shuffle and sublistOf+ * Support for generic coarbitrary+ * When using the cover combinator, insufficient coverage now+ causes the property to fail++* API changes:+ * Test.QuickCheck.Function: new pattern synonym Fn+ * genericShrink no longer requires Typeable+ * Result has a new constructor InsufficientCoverage+ * resize throws an error if the size is negative++* Bug fixes:+ * Fix memory leaks+ * Exceptions thrown by callbacks now cause the test to fail+ * Fixed a bug where the cover combinator wouldn't give a+ warning if coverage was 0%++## QuickCheck 2.7.3 (released 2014-03-24)+* Add annotations for Safe Haskell.++## QuickCheck 2.7.2 (released 2014-03-22)+* Fix bug in cabal file which broke cabal test++## QuickCheck 2.7.1 (released 2014-03-20)+* Fixed bug - the Small modifier didn't work on unsigned types+* Changed arbitrarySizedIntegral to have an Integral constraint+ instead of just Num++## QuickCheck 2.7 (released 2014-03-19)++* New features:+ * New genericShrink function provides generic shrinking with GHC.+ * New combinator x === y: fails if x /= y, but also prints their values+ * New function generate :: Gen a -> IO a for running a generator.+ * New combinators infiniteList and infiniteListOf for generating infinite lists.+ * Several combinators added to the main Test.QuickCheck module which+ were previously languishing in other modules. Of particular interest:+ quickCheckAll, ioProperty.+ * New combinators delay and capture which can be used (unsafely!)+ to reuse the random number seed. Useful for generating+ polymorphic (rank-2) values.+ * A new Discard data type and a Testable instance for discarding test cases.+ * All modifiers now have Functor instances and accessor functions.+ * Pressing ctrl-C during shrinking now shows the last failed+ test case, rather than the current shrinking candidate.+ * Experimental support for UHC. You will need the latest version of Cabal from git.++* Better distribution of test data:+ * The Int generator now only generates fairly small numbers.+ * The new Small and Large modifiers control the distribution of integers+ (Small generates small numbers, Large from the whole range).+ * Floating-point numbers shrink better.++* Improved random number generation:+ * QuickCheck now uses TFGen rather than StdGen on newer versions+ of GHC, because StdGen's random numbers aren't always random.+ * 'variant' now uses a prefix code. This should prevent some+ potential bananaskins with coarbitrary.++* API changes:+ * The Gen monad now uses an abstract type QCGen rather than StdGen.+ * The Result type now returns the thrown exception and number+ of failed shrink attempts.+ * Property is now a newtype rather than Gen Prop as it was before.+ * promote is moved into the new module Test.QuickCheck.Gen.Unsafe.+ * 'printTestCase' is deprecated - its new name is 'counterexample'+ * 'morallyDubiousIOProperty' is deprecated - its new name is+ 'ioProperty', no moral judgement involved :)++## QuickCheck 2.6 (released 2013-03-07)++* Add convenience Function instances for up to 7-tuples+* Make stderr line buffered to reduce console I/O.+* Return a flag to say whether the test case was interrupted.++## QuickCheck 2.5 (released 2012-06-18)++* Replace maxDiscard with maxDiscardRatio+* Remove Testable () instance.+* Added a 'discard' exception that discards the current test case+* Add accessors for modifiers (where it makes sense)+* Rename 'stop' to 'abort' to avoid a name clash+* Added a 'once' combinator+* If a property is of type Bool, only run it once+* Add coarbitraryEnum to Test.QuickCheck module.+* Add 'coarbitrary' helper for Enums.+* Rejiggled the formatting code to support multi-line error messages+* Add instances for Ordering and Fixed.+* Added arbitraryBoundedEnum generator (thanks to Antoine Latter).+* Add verboseCheckAll and polyverboseCheck function for usability.
examples/Heap.hs view
@@ -72,7 +72,7 @@ toSortedList :: Ord a => Heap a -> [a] toSortedList Empty = []-toSortedList (Node x h1 h2) = x : toList (h1 `merge` h2)+toSortedList (Node x h1 h2) = x : toSortedList (h1 `merge` h2) -------------------------------------------------------------------------- -- specification@@ -144,7 +144,7 @@ -- main return []-main = $quickCheckAll+main = do True <- $quickCheckAll; return () -------------------------------------------------------------------------- -- the end.
examples/Heap_Program.hs view
@@ -187,7 +187,7 @@ -- main return []-main = $(quickCheckAll)+main = do True <- $quickCheckAll; return () -------------------------------------------------------------------------- -- the end.
examples/Heap_ProgramAlgebraic.hs view
@@ -245,7 +245,7 @@ -- main return []-main = $(quickCheckAll)+main = do True <- $quickCheckAll; return () -------------------------------------------------------------------------- -- the end.
examples/Merge.hs view
@@ -110,7 +110,7 @@ -- mapSize (`div` 2) $ \(xss :: [OrderedList Int]) -> return []-main = $quickCheckAll+main = do True <- $quickCheckAll; return () -------------------------------------------------------------------------- -- the end.
examples/Set.hs view
@@ -201,7 +201,7 @@ -- main return []-main = $quickCheckAll+main = do True <- $quickCheckAll; return () -------------------------------------------------------------------------- -- the end.
examples/Simple.hs view
@@ -40,7 +40,7 @@ prop_disj = counterexample "reverse" $(monomorphic 'prop_Reverse) .||. counterexample "Simon Thompson" $(monomorphic 'prop_SimonThompson) return []-main = $quickCheckAll+main = do True <- $quickCheckAll; return () -------------------------------------------------------------------------- -- the end.
make-hugs view
@@ -19,6 +19,7 @@ -DNO_SAFE_HASKELL -DNO_POLYKINDS -DNO_MONADFAIL -DNO_TIMEOUT \ -DNO_NEWTYPE_DERIVING -DNO_TYPEABLE -DNO_GADTS -DNO_TRANSFORMERS \ -DNO_DEEPSEQ -DNO_EXTRA_METHODS_IN_APPLICATIVE -DNO_CALLSTACK \+ -DNO_SEMIGROUP -DNO_EXISTENTIAL_FIELD_SELECTORS \ "$src" > "$tgt" done
src/Test/QuickCheck.hs view
@@ -19,9 +19,9 @@ >>> quickCheck prop_reverse +++ OK, passed 100 tests. -To run more tests you can use the 'withMaxSuccess' combinator:+To run more tests you can use the 'withNumTests' combinator: ->>> quickCheck (withMaxSuccess 10000 prop_reverse)+>>> quickCheck (withNumTests 10000 prop_reverse) +++ OK, passed 10000 tests. To use QuickCheck on your own data types you will need to write 'Arbitrary'@@ -50,8 +50,8 @@ +++ Ok, passed 100 tests. @ -That's because GHCi will default any type variables in your property to '()', so in the example-above @quickCheck@ was really testing that '()' is equal to itself. To avoid this behaviour it+That's because GHCi will default any type variables in your property to @()@, so in the example+above @quickCheck@ was really testing that @()@ is equal to itself. To avoid this behaviour it is best practise to monomorphise your polymorphic properties when testing: @@@ -73,7 +73,7 @@ ( -- * Running tests quickCheck- , Args(..), Result(..)+ , Args(..), Result(..), TestProgress(..) , stdArgs , quickCheckWith , quickCheckWithResult@@ -132,6 +132,11 @@ , choose , chooseInt , chooseInteger+#ifndef NO_SPLITMIX+ , chooseWord64+ , chooseInt64+ , chooseUpTo+#endif , chooseBoundedIntegral , chooseEnum , chooseAny@@ -236,24 +241,24 @@ -- -- @ -- -- Functions cannot be shown (but see 'Function')- -- prop_TakeDropWhile ('Blind' p) (xs :: ['A']) =+ -- prop_TakeDropWhile ('Blind' p) (xs :: ['Test.QuickCheck.Poly.A']) = -- takeWhile p xs ++ dropWhile p xs == xs -- @ -- -- @- -- prop_TakeDrop ('NonNegative' n) (xs :: ['A']) =+ -- prop_TakeDrop ('NonNegative' n) (xs :: ['Test.QuickCheck.Poly.A']) = -- take n xs ++ drop n xs == xs -- @ -- -- @ -- -- cycle does not work for empty lists- -- prop_Cycle ('NonNegative' n) ('NonEmpty' (xs :: ['A'])) =+ -- prop_Cycle ('NonNegative' n) ('NonEmpty' (xs :: ['Test.QuickCheck.Poly.A'])) = -- take n (cycle xs) == take n (xs ++ cycle xs) -- @ -- -- @ -- -- Instead of 'forAll' 'orderedList'- -- prop_Sort ('Ordered' (xs :: ['OrdA'])) =+ -- prop_Sort ('Ordered' (xs :: ['Test.QuickCheck.Poly.OrdA'])) = -- sort xs == xs -- @ , Blind(..)@@ -302,6 +307,7 @@ , verbose , verboseShrinking , noShrinking+ , withNumTests , withMaxSuccess , within , discardAfter@@ -315,8 +321,10 @@ , (.&.) , (.&&.) , conjoin+ , Every (..) , (.||.) , disjoin+ , Some (..) -- ** What to do on failure #ifndef NO_TYPEABLE , Witness(..)@@ -326,6 +334,7 @@ #endif , counterexample , printTestCase+ , withProgress , whenFail , whenFail' , expectFailure@@ -355,6 +364,7 @@ import Test.QuickCheck.Gen import Test.QuickCheck.Arbitrary import Test.QuickCheck.Modifiers+import Test.QuickCheck.Monoids import Test.QuickCheck.Property hiding ( Result(..) ) import Test.QuickCheck.Test import Test.QuickCheck.Exception
src/Test/QuickCheck/All.hs view
@@ -20,6 +20,7 @@ verboseCheckAll, forAllProperties, allProperties,+ runQuickCheckAll, -- ** Testing polymorphic properties polyQuickCheck, polyVerboseCheck,
src/Test/QuickCheck/Arbitrary.hs view
@@ -89,18 +89,20 @@ import Control.Applicative import Data.Foldable(toList)+#if MIN_VERSION_random(1,3,0)+import System.Random(Random, uniformByteArray)+#else import System.Random(Random)+#endif import Test.QuickCheck.Gen import Test.QuickCheck.Random import Test.QuickCheck.Gen.Unsafe--{--import Data.Generics- ( (:*:)(..)- , (:+:)(..)- , Unit(..)- )--}+#if defined(__MHS__)+-- These two are not exported by Control.Applicative.+-- Why should they be? They are just bloat.+import Data.ZipList+import Control.WrappedMonad+#endif import Data.Char ( ord@@ -136,16 +138,25 @@ , nub ) + import Data.Version (Version (..)) #if defined(MIN_VERSION_base)-#if MIN_VERSION_base(4,2,0)+import Numeric.Natural++import Data.List.NonEmpty (NonEmpty)+import qualified Data.List.NonEmpty as NonEmpty+ import System.IO ( Newline(..) , NewlineMode(..)+ , SeekMode(..)+ , BufferMode(..)+ , TextEncoding+ , latin1, utf8, utf8_bom, utf16, utf16le, utf16be, utf32, utf32le, utf32be, localeEncoding, char8+ , IOMode(..) ) #endif-#endif import Control.Monad ( liftM@@ -175,9 +186,11 @@ #endif import qualified Data.Sequence as Sequence import qualified Data.Tree as Tree-import Data.Bits import qualified Data.Monoid as Monoid+#if defined(MIN_VERSION_base)+import qualified Data.Semigroup as Semigroup+#endif #ifndef NO_TRANSFORMERS import Data.Functor.Identity@@ -186,6 +199,28 @@ import Data.Functor.Product #endif +#if defined(MIN_VERSION_base)+import qualified Data.Semigroup as Semigroup+import Data.Ord++import System.Console.GetOpt+ ( ArgDescr(..), ArgOrder(..), OptDescr(..) )++import Data.Functor.Contravariant++import Data.Array.Byte+import qualified GHC.Exts as Exts++#if MIN_VERSION_base(4,16,0)+import Data.Tuple+#endif+#endif++import Data.Bits+import Text.Printf++import Test.QuickCheck.Compat+ -------------------------------------------------------------------------- -- ** class Arbitrary @@ -202,7 +237,8 @@ -- It is worth spending time thinking about what sort of test data -- you want - good generators are often the difference between -- finding bugs and not finding them. You can use 'sample',- -- 'label' and 'classify' to check the quality of your test data.+ -- 'Test.QuickCheck.label' and 'Test.QuickCheck.classify' to check the quality+ -- of your test data. -- -- There is no generic @arbitrary@ implementation included because we don't -- know how to make a high-quality one. If you want one, consider using the@@ -243,8 +279,8 @@ -- > shrink (Branch x l r) = -- > -- shrink Branch to Nil -- > [Nil] ++- -- > -- shrink to subterms- -- > [l, r] +++ -- > -- shrink to non-Nil subterms+ -- > [t | t@Branch{} <- [l, r]] ++ -- > -- recursively shrink subterms -- > [Branch x' l' r' | (x', l', r') <- shrink (x, l, r)] --@@ -492,14 +528,16 @@ xs1 = take k xs xs2 = drop k xs -{-- -- "standard" definition for lists:- shrink [] = []- shrink (x:xs) = [ xs ]- ++ [ x:xs' | xs' <- shrink xs ]- ++ [ x':xs | x' <- shrink x ]--}+#if defined(MIN_VERSION_base)+instance Arbitrary1 NonEmpty where+ liftArbitrary arb = NonEmpty.fromList <$> listOf1 arb+ liftShrink shr xs = [ NonEmpty.fromList xs' | xs' <- liftShrink shr (NonEmpty.toList xs), not (null xs') ] +instance Arbitrary a => Arbitrary (NonEmpty a) where+ arbitrary = arbitrary1+ shrink = shrink1+#endif+ instance Integral a => Arbitrary (Ratio a) where arbitrary = sized $ \ n -> do denom <- chooseInt (1, max 1 n)@@ -512,7 +550,8 @@ pure $ fromI numer % fromI denom shrink = shrinkRealFrac -#if defined(MIN_VERSION_base) && MIN_VERSION_base(4,4,0)++#if defined(MIN_VERSION_base) instance Arbitrary a => Arbitrary (Complex a) where #else instance (RealFloat a, Arbitrary a) => Arbitrary (Complex a) where@@ -644,6 +683,12 @@ arbitrary = arbitrarySizedIntegral shrink = shrinkIntegral +#if defined(MIN_VERSION_base)+instance Arbitrary Natural where+ arbitrary = arbitrarySizedNatural+ shrink = shrinkIntegral+#endif+ instance Arbitrary Int where arbitrary = arbitrarySizedIntegral shrink = shrinkIntegral@@ -721,7 +766,7 @@ ] where smallDenominators = sized $ \n -> do- i <- chooseInt (0, n)+ i <- chooseInt (0, min n 256) pure (fromRational (streamNth i rationalUniverse)) uniform = sized $ \n -> do@@ -747,7 +792,7 @@ ] where smallDenominators = sized $ \n -> do- i <- chooseInt (0, n)+ i <- chooseInt (0, min n 256) pure (fromRational (streamNth i rationalUniverse)) uniform = sized $ \n -> do@@ -1019,7 +1064,6 @@ 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@@ -1027,15 +1071,172 @@ 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++instance Arbitrary a => Arbitrary (Semigroup.Min a) where+ arbitrary = fmap Semigroup.Min arbitrary+ shrink = map Semigroup.Min . shrink . Semigroup.getMin++instance Arbitrary a => Arbitrary (Semigroup.Max a) where+ arbitrary = fmap Semigroup.Max arbitrary+ shrink = map Semigroup.Max . shrink . Semigroup.getMax++instance Arbitrary a => Arbitrary (Semigroup.First a) where+ arbitrary = fmap Semigroup.First arbitrary+ shrink = map Semigroup.First . shrink . Semigroup.getFirst++instance Arbitrary a => Arbitrary (Semigroup.Last a) where+ arbitrary = fmap Semigroup.Last arbitrary+ shrink = map Semigroup.Last . shrink . Semigroup.getLast++instance (Arbitrary a, Arbitrary b) => Arbitrary (Semigroup.Arg a b) where+ arbitrary = Semigroup.Arg <$> arbitrary <*> arbitrary+ shrink (Semigroup.Arg a b) = uncurry Semigroup.Arg <$> shrink (a, b)++instance Arbitrary a => Arbitrary (Semigroup.WrappedMonoid a) where+ arbitrary = Semigroup.WrapMonoid <$> arbitrary+ shrink = map Semigroup.WrapMonoid . shrink . Semigroup.unwrapMonoid++#if !MIN_VERSION_base(4,15,0)+instance Arbitrary a => Arbitrary (Semigroup.Option a) where+ arbitrary = Semigroup.Option <$> arbitrary+ shrink = map Semigroup.Option . shrink . Semigroup.getOption++instance CoArbitrary a => CoArbitrary (Semigroup.Option a) where+ coarbitrary = coarbitrary . Semigroup.getOption #endif++#if MIN_VERSION_base(4,16,0)+instance Arbitrary a => Arbitrary (Iff a) where+ arbitrary = Iff <$> arbitrary+ shrink = map Iff . shrink . getIff++instance Arbitrary a => Arbitrary (Ior a) where+ arbitrary = Ior <$> arbitrary+ shrink = map Ior . shrink . getIor++instance Arbitrary a => Arbitrary (Xor a) where+ arbitrary = Xor <$> arbitrary+ shrink = map Xor . shrink . getXor++instance Arbitrary a => Arbitrary (And a) where+ arbitrary = And <$> arbitrary+ shrink = map And . shrink . getAnd++instance CoArbitrary a => CoArbitrary (And a) where+ coarbitrary = coarbitrary . getAnd++instance CoArbitrary a => CoArbitrary (Iff a) where+ coarbitrary = coarbitrary . getIff++instance CoArbitrary a => CoArbitrary (Ior a) where+ coarbitrary = coarbitrary . getIor++instance CoArbitrary a => CoArbitrary (Xor a) where+ coarbitrary = coarbitrary . getXor #endif +#if !defined(__MHS__)+instance Arbitrary ByteArray where+#if MIN_VERSION_random(1,3,0)+ arbitrary = do+ pin <- arbitrary+ len <- abs <$> arbitrary+ MkGen $ \ qcGen _ -> fst $ uniformByteArray pin len qcGen+#else+ arbitrary = Exts.fromList <$> arbitrary+#endif+ shrink = map Exts.fromList . shrink . Exts.toList++instance CoArbitrary ByteArray where+ coarbitrary = coarbitrary . Exts.toList++-- MicroHs does not have Exts.fromList+#endif /* !defined(__MHS__) */++#if MIN_VERSION_base(4,16,0)++instance Arbitrary a => Arbitrary (Solo a) where+ arbitrary = mkSolo <$> arbitrary+ shrink = map mkSolo . shrink . getSolo++instance CoArbitrary a => CoArbitrary (Solo a) where+ coarbitrary = coarbitrary . getSolo++#endif++instance Arbitrary a => Arbitrary (Down a) where+ arbitrary = fmap Down arbitrary+ shrink = map Down . shrink . getDown++instance CoArbitrary a => CoArbitrary (Down a) where+ coarbitrary = coarbitrary . getDown++#endif++#ifdef __GLASGOW_HASKELL__++instance Arbitrary a => Arbitrary (ArgDescr a) where+ arbitrary = oneof [ NoArg <$> arbitrary+ , ReqArg <$> arbitrary <*> arbitrary+ , OptArg <$> arbitrary <*> arbitrary+ ]++ shrink (NoArg i) = [ NoArg i' | i' <- shrink i ]+ shrink (ReqArg a1 a2) = [ ReqArg a1' a2 | a1' <- shrink a1 ] +++ [ ReqArg a1 a2' | a2' <- shrink a2 ]+ shrink (OptArg a1 a2) = [ OptArg a1' a2 | a1' <- shrink a1 ] +++ [ OptArg a1 a2' | a2' <- shrink a2 ]++instance Arbitrary a => Arbitrary (ArgOrder a) where+ arbitrary = oneof [ return RequireOrder+ , return Permute+ , ReturnInOrder <$> arbitrary+ ]++ shrink RequireOrder = []+ shrink Permute = []+ shrink (ReturnInOrder a) = [ ReturnInOrder a' | a' <- shrink a ]++instance Arbitrary a => Arbitrary (OptDescr a) where+ arbitrary = Option+ <$> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary++ shrink (Option a b c d) = [ Option a' b c d | a' <- shrink a ] +++ [ Option a b' c d | b' <- shrink b ] +++ [ Option a b c' d | c' <- shrink c ] +++ [ Option a b c d' | d' <- shrink d ]++-- Data.Functor.Contravariant++-- can maybe use Arbitrary1/2 for these+instance CoArbitrary a => Arbitrary (Predicate a) where+ arbitrary = Predicate <$> arbitrary++ shrink (Predicate p) = [ Predicate p' | p' <- shrink p ]++instance (Arbitrary a, CoArbitrary b) => Arbitrary (Op a b) where+ arbitrary = Op <$> arbitrary++ shrink (Op f) = [ Op f' | f' <- shrink f ]++instance CoArbitrary a => Arbitrary (Equivalence a) where+ arbitrary = do+ Comparison cmp <- arbitrary+ return $ Equivalence (\x y -> cmp x y == EQ)++instance CoArbitrary a => Arbitrary (Comparison a) where+ arbitrary = do+ Comparison . comparing <$> (liftArbitrary arbitrary :: Gen (a -> Integer))++#endif+ -- | Generates 'Version' with non-empty non-negative @versionBranch@, and empty @versionTags@ instance Arbitrary Version where arbitrary = sized $ \n ->@@ -1064,7 +1265,6 @@ shrink _ = [] #if defined(MIN_VERSION_base)-#if MIN_VERSION_base(4,2,0) instance Arbitrary Newline where arbitrary = elements [LF, CRLF] @@ -1080,7 +1280,56 @@ arbitrary = NewlineMode <$> arbitrary <*> arbitrary shrink (NewlineMode inNL outNL) = [NewlineMode inNL' outNL' | (inNL', outNL') <- shrink (inNL, outNL)]-#endif++instance Arbitrary GeneralCategory where+ arbitrary = arbitraryBoundedEnum+ shrink = shrinkBoundedEnum++instance Arbitrary SeekMode where+ arbitrary = elements [ AbsoluteSeek, RelativeSeek, SeekFromEnd ]+ shrink x = takeWhile (x /=) [ AbsoluteSeek, RelativeSeek, SeekFromEnd ]++instance Arbitrary TextEncoding where+ arbitrary = elements [ latin1, utf8, utf8_bom, utf16, utf16le, utf16be, utf32, utf32le, utf32be, localeEncoding, char8 ]++instance Arbitrary BufferMode where+ arbitrary = oneof [ pure NoBuffering+ , pure LineBuffering+ , pure $ BlockBuffering Nothing+ , BlockBuffering . Just . (+1) . fromIntegral <$> (arbitrary :: Gen Natural)+ ]+ shrink NoBuffering = []+ shrink LineBuffering = [ NoBuffering ]+ shrink (BlockBuffering m) = [ NoBuffering, LineBuffering ] ++ map BlockBuffering (filter (maybe True (>0)) $ shrink m)++instance Arbitrary IOMode where+ arbitrary = elements [ReadMode, WriteMode, AppendMode, ReadWriteMode]+ shrink x = takeWhile (/=x) [ReadMode, WriteMode, AppendMode, ReadWriteMode]++instance Arbitrary FormatSign where+ arbitrary = elements [SignPlus, SignSpace]+ shrink SignPlus = []+ shrink SignSpace = [SignPlus]++instance Arbitrary FormatAdjustment where+ arbitrary = elements [LeftAdjust, ZeroPad]+ shrink LeftAdjust = []+ shrink ZeroPad = [LeftAdjust]++instance Arbitrary FormatParse where+ arbitrary = FormatParse <$> arbitrary <*> arbitrary <*> arbitrary+ shrink (FormatParse a b c) = [ FormatParse a' b' c' | (a', b', c') <- shrink (a, b, c) ]++instance Arbitrary FieldFormat where+ arbitrary = FieldFormat <$> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ shrink (FieldFormat a b c d e f g) = [ FieldFormat a' b' c' d' e' f' g' | (a', b', c', d', e', f', g') <- shrink (a, b, c, d, e, f, g) ]+ #endif -- ** Helper functions for implementing arbitrary@@ -1233,20 +1482,8 @@ -- | Shrink an integral number. shrinkIntegral :: Integral a => a -> [a] shrinkIntegral x =- nub $- [ -x- | x < 0, -x > x- ] ++- [ x'- | x' <- takeWhile (<< x) (0:[ x - i | i <- tail (iterate (`quot` 2) x) ])- ]- where- -- a << b is "morally" abs a < abs b, but taking care of overflow.- a << b = case (a >= 0, b >= 0) of- (True, True) -> a < b- (False, False) -> a > b- (True, False) -> a + b < 0- (False, True) -> a + b > 0+ [ -x | x < 0, -x > x ] +++ [ x - i | i <- takeWhile (/= 0) (iterate (`quot` 2) x)] -- | Shrink an element of a bounded enumeration. --@@ -1432,7 +1669,7 @@ coarbitrary = coarbitraryReal #endif -#if defined(MIN_VERSION_base) && MIN_VERSION_base(4,4,0)+#if defined(MIN_VERSION_base) instance CoArbitrary a => CoArbitrary (Complex a) where #else instance (RealFloat a, CoArbitrary a) => CoArbitrary (Complex a) where@@ -1513,6 +1750,11 @@ instance CoArbitrary Double where coarbitrary = coarbitraryReal +#if defined(MIN_VERSION_base)+instance CoArbitrary Natural where+ coarbitrary = coarbitraryIntegral+#endif+ -- Coarbitrary instances for container types instance CoArbitrary a => CoArbitrary (Set.Set a) where coarbitrary = coarbitrary. Set.toList@@ -1531,6 +1773,12 @@ instance CoArbitrary a => CoArbitrary (ZipList a) where coarbitrary = coarbitrary . getZipList +-- CoArbitrary instance for NonEmpty+#if defined(MIN_VERSION_base)+instance CoArbitrary a => CoArbitrary (NonEmpty a) where+ coarbitrary (a NonEmpty.:| as) = coarbitrary (a, as)+#endif+ #ifndef NO_TRANSFORMERS -- CoArbitrary instance for transformers' Functors instance CoArbitrary a => CoArbitrary (Identity a) where@@ -1564,34 +1812,99 @@ 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)+instance CoArbitrary a => CoArbitrary (Semigroup.Max a) where+ coarbitrary = coarbitrary . Semigroup.getMax -#if defined(MIN_VERSION_base)-#if MIN_VERSION_base(4,2,0)+instance CoArbitrary a => CoArbitrary (Semigroup.Min a) where+ coarbitrary = coarbitrary . Semigroup.getMin++instance CoArbitrary a => CoArbitrary (Semigroup.First a) where+ coarbitrary = coarbitrary . Semigroup.getFirst++instance CoArbitrary a => CoArbitrary (Semigroup.Last a) where+ coarbitrary = coarbitrary . Semigroup.getLast+ instance CoArbitrary Newline where coarbitrary LF = variant 0 coarbitrary CRLF = variant 1 instance CoArbitrary NewlineMode where coarbitrary (NewlineMode inNL outNL) = coarbitrary inNL . coarbitrary outNL++instance (CoArbitrary a, CoArbitrary b) => CoArbitrary (Semigroup.Arg a b) where+ coarbitrary (Semigroup.Arg a b) = coarbitrary (a, b)++instance CoArbitrary GeneralCategory where+ coarbitrary = coarbitrary . fromEnum++instance CoArbitrary SeekMode where+ coarbitrary = coarbitrary . fromEnum++instance CoArbitrary IOMode where+#if !defined(__MHS__)+ coarbitrary = coarbitrary . fromEnum+#else+ coarbitrary ReadMode = variant 0+ coarbitrary WriteMode = variant 1+ coarbitrary AppendMode = variant 2+ coarbitrary ReadWriteMode = variant 3 #endif++instance CoArbitrary FieldFormat where+ coarbitrary ff = coarbitrary (fmtWidth ff)+ . coarbitrary (fmtPrecision ff)+ . coarbitrary (fmtAdjust ff)+ . coarbitrary (fmtSign ff)+ . coarbitrary (fmtAlternate ff)+ . coarbitrary (fmtModifiers ff)+ . coarbitrary (fmtChar ff)++instance CoArbitrary FormatParse where+ coarbitrary fp = coarbitrary (fpModifiers fp)+ . coarbitrary (fpChar fp)+ . coarbitrary (fpRest fp)++instance CoArbitrary FormatAdjustment where+ coarbitrary LeftAdjust = coarbitrary True+ coarbitrary ZeroPad = coarbitrary False++instance CoArbitrary FormatSign where+ coarbitrary SignPlus = coarbitrary True+ coarbitrary SignSpace = coarbitrary False++instance CoArbitrary BufferMode where+ coarbitrary = coarbitrary . embed+ where embed NoBuffering = Left True+ embed LineBuffering = Left False+ embed (BlockBuffering m) = Right m++instance CoArbitrary ExitCode where+ coarbitrary = coarbitrary . embed+ where embed ExitSuccess = Nothing+ embed (ExitFailure i) = Just i++#if !defined(__MHS__)+instance CoArbitrary TextEncoding where+ coarbitrary = coarbitrary . show -- No other way as far as I can tell :( #endif +instance CoArbitrary a => CoArbitrary (Semigroup.WrappedMonoid a) where+ coarbitrary = coarbitrary . Semigroup.unwrapMonoid++#endif++instance CoArbitrary Version where+ coarbitrary (Version a b) = coarbitrary (a, b)+ -- ** Helpers for implementing coarbitrary -- | A 'coarbitrary' implementation for integral numbers.@@ -1638,8 +1951,9 @@ streamNth n (x :< xs) | n <= 0 = x | otherwise = streamNth (n - 1) xs --- We read into this stream only with ~size argument,--- so it's ok to have it as CAF.+-- We read into this stream only with ~size argument, capped to 256,+-- so it's ok to have it as CAF. (256 chosen somewhat arbitrarily, the+-- point is just to stop this blowing up.) -- rationalUniverse :: Stream Rational rationalUniverse = 0 :< 1 :< (-1) :< go leftSideStream
+ src/Test/QuickCheck/Compat.hs view
@@ -0,0 +1,34 @@+-- This module provides tools to simplify compat code across different compiler and library versions+{-# LANGUAGE CPP #-}+module Test.QuickCheck.Compat where++#if MIN_VERSION_base(4,16,0)+import Data.Tuple+#endif++#if MIN_VERSION_base(4,16,0)++#if !MIN_VERSION_base(4,18,0)++getSolo :: Solo a -> a+getSolo (Solo a) = a++mkSolo :: a -> Solo a+mkSolo = Solo++#elif !MIN_VERSION_base(4,19,0)++getSolo :: Solo a -> a+getSolo (MkSolo a) = a++mkSolo :: a -> Solo a+mkSolo = MkSolo++#else++mkSolo :: a -> Solo a+mkSolo = MkSolo++#endif++#endif
src/Test/QuickCheck/Exception.hs view
@@ -10,7 +10,7 @@ #endif module Test.QuickCheck.Exception where -#if !defined(__GLASGOW_HASKELL__) || (__GLASGOW_HASKELL__ < 700)+#if (!defined(__GLASGOW_HASKELL__) || (__GLASGOW_HASKELL__ < 700)) && !defined(__MHS__) #define OLD_EXCEPTIONS #endif @@ -63,7 +63,7 @@ tryEvaluateIO m = E.tryJust notAsync (m >>= E.evaluate) where notAsync :: AnException -> Maybe AnException-#if MIN_VERSION_base(4,7,0)+#if defined(MIN_VERSION_base) notAsync e = case E.fromException e of Just (E.SomeAsyncException _) -> Nothing Nothing -> Just e
src/Test/QuickCheck/Features.hs view
@@ -11,6 +11,7 @@ import Test.QuickCheck.Gen import Test.QuickCheck.State import Test.QuickCheck.Text+import Test.QuickCheck.Random import qualified Data.Set as Set import Data.Set(Set) import Data.List (intersperse)@@ -85,26 +86,23 @@ -- | A variant of 'labelledExamples' that takes test arguments and returns a result. labelledExamplesWithResult :: Testable prop => Args -> prop -> IO Result-labelledExamplesWithResult args prop =- withState args $ \state -> do- let- loop :: Set String -> State -> IO Result- loop feats state = withNullTerminal $ \nullterm -> do- res <- test state{terminal = nullterm} (property (prop_noNewFeatures feats prop))- let feats' = features (failingLabels res) (failingClasses res)- case res of- Failure{reason = "New feature found"} -> do- putLine (terminal state) $- "*** Found example of " ++- concat (intersperse ", " (Set.toList (feats' Set.\\ feats)))- mapM_ (putLine (terminal state)) (failingTestCase res)- putStrLn ""- loop (Set.union feats feats')- state{randomSeed = usedSeed res, replayStartSize = Just $ usedSize res}- _ -> do- out <- terminalOutput nullterm- putStr out- return res- at0 f s 0 0 = s- at0 f s n d = f n d- loop Set.empty state+labelledExamplesWithResult args prop = loop Set.empty $ replay args+ where+ loop :: Set String -> Maybe (QCGen, Int) -> IO Result+ loop feats replay = withNullTerminal $ \nullterm -> do+ res <- quickCheckWithResult args{chatty = False, replay = replay} (prop_noNewFeatures feats prop)+ let feats' = features (failingLabels res) (failingClasses res)+ case res of+ Failure{reason = "New feature found"} -> do+ putStrLn $+ "*** Found example of " +++ concat (intersperse ", " (Set.toList (feats' Set.\\ feats)))+ mapM_ putStrLn (failingTestCase res)+ putStrLn ""+ loop (Set.union feats feats') (Just (usedSeed res, usedSize res))+ _ -> do+ out <- terminalOutput nullterm+ putStr out+ return res+ at0 f s 0 0 = s+ at0 f s n d = f n d
src/Test/QuickCheck/Function.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE TypeOperators, GADTs, CPP, Rank2Types #-} #ifndef NO_SAFE_HASKELL-{-# LANGUAGE Safe #-}+{-# LANGUAGE Trustworthy #-} #endif #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708 {-# LANGUAGE PatternSynonyms, ViewPatterns #-}@@ -37,6 +37,7 @@ -- See the @'Function' [a]@ instance for an example of the latter. module Test.QuickCheck.Function ( Fun(..)+ , mkFun , applyFun , apply , applyFun2@@ -83,15 +84,31 @@ import Data.Foldable(toList) import Data.Functor.Identity import qualified Data.Monoid as Monoid+import qualified Data.Semigroup as Semigroup+import qualified Data.List.NonEmpty as NonEmpty+import Numeric.Natural+import qualified Data.Bits as Bits+import Data.Tuple+import Data.Ord+import Data.Functor.Contravariant+import Text.Printf+import System.IO+import System.Exit+import Data.Version+import Data.Array.Byte+import qualified GHC.Exts as Exts +#if defined(__MHS__)+import Data.ZipList+import Control.WrappedMonad+#endif+ #if defined(MIN_VERSION_base)-#if MIN_VERSION_base(4,2,0) import System.IO ( Newline(..) , NewlineMode(..) ) #endif-#endif #ifndef NO_FIXED import Data.Fixed@@ -101,6 +118,8 @@ import GHC.Generics hiding (C) #endif +import Test.QuickCheck.Compat+ -------------------------------------------------------------------------- -- concrete functions @@ -136,7 +155,14 @@ -- turning a concrete function into an abstract function (with a default result) abstract :: (a :-> c) -> c -> (a -> c)+#if defined(__MHS__)+{- This is a temporary fix for a deficiency in the MicroHs type checker. -}+abstract (Pair p) d xy =+ case xy of+ (x,y) -> abstract (fmap (\q -> abstract q d y) p) d x+#else abstract (Pair p) d (x,y) = abstract (fmap (\q -> abstract q d y) p) d x+#endif abstract (p :+: q) d exy = either (abstract p d) (abstract q d) exy abstract (Unit c) _ _ = c abstract Nil d _ = d@@ -261,6 +287,12 @@ h (Left _) = [] h (Right (x,xs)) = x:xs +instance Function a => Function (NonEmpty.NonEmpty a) where+ function = functionMap (\(a NonEmpty.:| as) -> (a, as)) (\(a, as) -> a NonEmpty.:| as)++instance Function a => Function (ZipList a) where+ function = functionMap getZipList ZipList+ instance Function a => Function (Maybe a) where function = functionMap g h where@@ -309,6 +341,9 @@ instance Function Double where function = functionRealFrac +instance Function Natural where+ function = functionIntegral+ -- instances for assorted types in the base package instance Function Ordering where@@ -382,7 +417,6 @@ function = functionIntegral #if defined(MIN_VERSION_base)-#if MIN_VERSION_base(4,2,0) instance Function Newline where function = functionMap g h where@@ -398,7 +432,6 @@ g (NewlineMode inNL outNL) = (inNL,outNL) h (inNL,outNL) = NewlineMode inNL outNL #endif-#endif -- instances for Data.Monoid newtypes @@ -423,11 +456,113 @@ instance Function a => Function (Monoid.Last a) where function = functionMap Monoid.getLast Monoid.Last -#if MIN_VERSION_base(4,8,0) instance Function (f a) => Function (Monoid.Alt f a) where function = functionMap Monoid.getAlt Monoid.Alt++instance Function a => Function (Semigroup.Min a) where+ function = functionMap Semigroup.getMin Semigroup.Min++instance Function a => Function (Semigroup.Max a) where+ function = functionMap Semigroup.getMax Semigroup.Max++instance Function a => Function (Semigroup.Last a) where+ function = functionMap Semigroup.getLast Semigroup.Last++instance Function a => Function (Semigroup.First a) where+ function = functionMap Semigroup.getFirst Semigroup.First++instance Function a => Function (Semigroup.WrappedMonoid a) where+ function = functionMap Semigroup.unwrapMonoid Semigroup.WrapMonoid++instance (Function a, Function b) => Function (Semigroup.Arg a b) where+ function = functionMap (\(Semigroup.Arg a b) -> (a, b)) (uncurry Semigroup.Arg)++#if MIN_VERSION_base(4,16,0)+instance Function a => Function (Bits.And a) where+ function = functionMap Bits.getAnd Bits.And++instance Function a => Function (Bits.Ior a) where+ function = functionMap Bits.getIor Bits.Ior++instance Function a => Function (Bits.Xor a) where+ function = functionMap Bits.getXor Bits.Xor++instance Function a => Function (Bits.Iff a) where+ function = functionMap Bits.getIff Bits.Iff #endif +instance Function FormatSign where+ function = functionMap (\x -> case x of SignPlus -> True; _ -> False) (\b -> if b then SignPlus else SignSpace)++instance Function FormatAdjustment where+ function = functionMap (\x -> case x of LeftAdjust -> True; _ -> False) (\b -> if b then LeftAdjust else ZeroPad)++instance Function FormatParse where+ function = functionMap to from+ where to fp = (fpModifiers fp, fpChar fp, fpRest fp)+ from (a, b, c) = FormatParse a b c++instance Function FieldFormat where+ function = functionMap to from+ where to ff = ( fmtWidth ff+ , fmtPrecision ff+ , fmtAdjust ff+ , fmtSign ff+ , fmtAlternate ff+ , fmtModifiers ff+ , fmtChar ff)+ from (a, b, c, d, e, f, g) = FieldFormat a b c d e f g++instance Function GeneralCategory where+ function = functionBoundedEnum++instance Function SeekMode where+ function = functionElements [AbsoluteSeek, RelativeSeek, SeekFromEnd]++instance Function IOMode where+ function = functionElements [ReadMode, WriteMode, AppendMode, ReadWriteMode]++instance Function BufferMode where+ function = functionMap to from+ where to NoBuffering = Left True+ to LineBuffering = Left False+ to (BlockBuffering m) = Right m++ from (Left True) = NoBuffering+ from (Left False) = LineBuffering+ from (Right m) = BlockBuffering m++instance Function ExitCode where+ function = functionMap to from+ where to ExitSuccess = Nothing+ to (ExitFailure c) = Just c++ from Nothing = ExitSuccess+ from (Just c) = ExitFailure c++instance Function Version where+ function = functionMap to from+ where to (Version a b) = (a, b)+ from (a, b) = Version a b++#if !defined(__MHS__)+instance Function ByteArray where+ function = functionMap Exts.toList Exts.fromList+#endif++#if MIN_VERSION_base(4,16,0)+instance Function a => Function (Solo a) where+ function = functionMap getSolo mkSolo+#endif++instance Function a => Function (Down a) where+ function = functionMap getDown Down++#if !MIN_VERSION_base(4,15,0)+instance Function a => Function (Semigroup.Option a) where+ function = functionMap Semigroup.getOption Semigroup.Option+#endif+ -- poly instances instance Function A where@@ -521,6 +656,7 @@ where shrXy (x,y) = [(x,y') | y' <- shr y] + table :: Eq aa => [(aa,cc)] -> (aa :-> cc) -- MicroHs needs this table [] = Nil table xys = Table xys @@ -584,6 +720,8 @@ #endif #endif +-- | Create a `Fun` from a function representation and a default value (in case the function+-- is partial). mkFun :: (a :-> b) -> b -> Fun a b mkFun p d = Fun (p, d, NotShrunk) (abstract p d)
src/Test/QuickCheck/Gen.hs view
@@ -21,7 +21,6 @@ ( Random , random , randomR- , split ) import Control.Monad@@ -89,7 +88,7 @@ MkGen m >>= k = MkGen (\r n ->- case split r of+ case splitImpl r of (r1, r2) -> let MkGen m' = k (m r1 n) in m' r2 n@@ -157,7 +156,7 @@ 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`.+-- | Generates a random element over the natural range of @a@. chooseAny :: Random a => Gen a chooseAny = MkGen (\r _ -> let (x,_) = random r in x) @@ -244,7 +243,7 @@ sample' g = generate (sequence [ resize n g | n <- [0,2..20] ]) --- | Generates some example values and prints them to 'stdout'.+-- | Generates some example values and prints them to 'System.IO.stdout'. sample :: Show a => Gen a -> IO () sample g = sequence_ [ do r <- newQCGen
src/Test/QuickCheck/Modifiers.hs view
@@ -24,24 +24,24 @@ -- -- @ -- -- Functions cannot be shown (but see "Test.QuickCheck.Function")--- prop_TakeDropWhile ('Blind' p) (xs :: ['A']) =+-- prop_TakeDropWhile ('Blind' p) (xs :: ['Test.QuickCheck.Poly.A']) = -- takeWhile p xs ++ dropWhile p xs == xs -- @ -- -- @--- prop_TakeDrop ('NonNegative' n) (xs :: ['A']) =+-- prop_TakeDrop ('NonNegative' n) (xs :: ['Test.QuickCheck.Poly.A']) = -- take n xs ++ drop n xs == xs -- @ -- -- @ -- -- cycle does not work for empty lists--- prop_Cycle ('NonNegative' n) ('NonEmpty' (xs :: ['A'])) =+-- prop_Cycle ('NonNegative' n) ('NonEmpty' (xs :: ['Test.QuickCheck.Poly.A'])) = -- take n (cycle xs) == take n (xs ++ cycle xs) -- @ -- -- @--- -- Instead of 'forAll' 'orderedList'--- prop_Sort ('Ordered' (xs :: ['OrdA'])) =+-- -- Instead of 'Test.QuickCheck.forAll' 'orderedList'+-- prop_Sort ('Ordered' (xs :: ['Test.QuickCheck.Poly.OrdA'])) = -- sort xs == xs -- @ module Test.QuickCheck.Modifiers@@ -62,6 +62,7 @@ , Small(..) , Smart(..) , Shrink2(..)+ , NoShrink(..) #ifndef NO_MULTI_PARAM_TYPE_CLASSES , Shrinking(..) , ShrinkState(..)@@ -164,14 +165,13 @@ instance Functor NonEmptyList where fmap f (NonEmpty x) = NonEmpty (map f x) -instance Arbitrary a => Arbitrary (NonEmptyList a) where- arbitrary = NonEmpty `fmap` (arbitrary `suchThat` (not . null))+instance Arbitrary1 NonEmptyList where+ liftArbitrary = fmap NonEmpty . listOf1+ liftShrink shr = map NonEmpty . filter (not . null) . shrinkList shr . getNonEmpty - shrink (NonEmpty xs) =- [ NonEmpty xs'- | xs' <- shrink xs- , not (null xs')- ]+instance Arbitrary a => Arbitrary (NonEmptyList a) where+ arbitrary = arbitrary1+ shrink = shrink1 ---------------------------------------------------------------------- -- | @InfiniteList xs _@: guarantees that xs is an infinite list.@@ -182,7 +182,7 @@ -- -- > prop_take_10 :: InfiniteList Char -> Bool -- > prop_take_10 (InfiniteList xs _) =--- > or [ x == 'a' | x <- take 10 xs ]+-- > or [ x == \'a\' | x <- take 10 xs ] -- -- In the following counterexample, the list must start with @"bbbbbbbbbb"@ but -- the remaining (infinite) part can contain anything:@@ -411,6 +411,24 @@ ] where shrink_x = shrink x++--------------------------------------------------------------------------+-- | @NoShrink x@: no shrinking+newtype NoShrink a = NoShrink {getNoShrink :: a}+ deriving ( Eq, Ord, Show, Read+#ifndef NO_NEWTYPE_DERIVING+ , Num, Integral, Real, Enum, Ix+#endif+#ifndef NO_TYPEABLE+ , Typeable+#endif+ )++instance Functor NoShrink where+ fmap f (NoShrink x) = NoShrink (f x)++instance Arbitrary a => Arbitrary (NoShrink a) where+ arbitrary = fmap NoShrink arbitrary -------------------------------------------------------------------------- -- | @Smart _ x@: tries a different order when shrinking.
src/Test/QuickCheck/Monadic.hs view
@@ -1,11 +1,7 @@ {-# LANGUAGE CPP #-} #ifndef NO_SAFE_HASKELL-#if !defined(NO_ST_MONAD) && !(MIN_VERSION_base(4,8,0))-{-# LANGUAGE Trustworthy #-}-#else {-# LANGUAGE Safe #-} #endif-#endif #ifndef NO_ST_MONAD {-# LANGUAGE Rank2Types #-} #endif@@ -142,9 +138,6 @@ instance Monad m => Monad (PropertyM m) where return = pure (>>=) = bind-#if !MIN_VERSION_base(4,13,0)- fail = fail_-#endif #ifndef NO_MONADFAIL instance Monad m => Fail.MonadFail (PropertyM m) where
+ src/Test/QuickCheck/Monoids.hs view
@@ -0,0 +1,83 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE Safe #-}++module Test.QuickCheck.Monoids+ ( Every (..)+ , Some (..)+ ) where++#ifndef NO_SEMIGROUP+import Data.List.NonEmpty as NonEmpty+import Data.Semigroup (Semigroup (..))+#else+import Data.Monoid (Monoid (..))+#endif+import Test.QuickCheck.Property++-- | Conjunction monoid built with `.&&.`.+--+-- Use `property @Every` as an accessor which doesn't leak+-- existential variables.+--+-- Note: monoid laws are satisfied up to 'Test.QuickCheck.isSuccess' unless one+-- is using `checkCoverage`.+--+#ifndef NO_EXISTENTIAL_FIELD_SELECTORS+data Every = forall p. Testable p => Every { getEvery :: p }+#else+data Every = forall p. Testable p => Every p+#endif++instance Testable Every where+ property (Every p) = property p++#ifndef NO_SEMIGROUP+instance Semigroup Every where+ Every p <> Every p' = Every (p .&&. p')+ sconcat = Every . conjoin . NonEmpty.toList++instance Monoid Every where+ mempty = Every True+ mappend = (<>)+ mconcat = Every . conjoin+#else+instance Monoid Every where+ mempty = Every True+ mappend (Every p) (Every p') = Every (p .&&. p')+ mconcat = Every . conjoin+#endif+++-- | Disjunction monoid built with `.||.`.+--+-- Use `property @Some` as an accessor which doesn't leak+-- existential variables.+--+-- Note: monoid laws are satisfied up to 'Test.QuickCheck.isSuccess' unless one+-- is using `checkCoverage`.+--+#ifndef NO_EXISTENTIAL_FIELD_SELECTORS+data Some = forall p. Testable p => Some { getSome :: p }+#else+data Some = forall p. Testable p => Some p+#endif++instance Testable Some where+ property (Some p) = property p++#ifndef NO_SEMIGROUP+instance Semigroup Some where+ Some p <> Some p' = Some (p .||. p')+ sconcat = Some . disjoin . NonEmpty.toList++instance Monoid Some where+ mempty = Some False+ mappend = (<>)+ mconcat = Some . disjoin+#else+instance Monoid Some where+ mempty = Some False+ mappend (Some p) (Some p') = Some (p .||. p')+ mconcat = Some . disjoin+#endif
src/Test/QuickCheck/Property.hs view
@@ -18,13 +18,16 @@ import Test.QuickCheck.Arbitrary import Test.QuickCheck.Text( isOneLine, putLine ) import Test.QuickCheck.Exception-import Test.QuickCheck.State( State(terminal), Confidence(..) )+import Test.QuickCheck.State( State(terminal, numSuccessTests, numDiscardedTests, maxSuccessTests, numSuccessShrinks, numTryShrinks, numTotTryShrinks), Confidence(..), TestProgress(..) ) #ifndef NO_TIMEOUT import System.Timeout(timeout) #endif import Data.Maybe import Control.Applicative+#if defined(MIN_VERSION_base)+import Control.Exception (displayException)+#endif import Control.Monad import qualified Data.Map as Map import Data.Map(Map)@@ -319,7 +322,11 @@ theException = Just err } formatException :: String -> AnException -> String+#if defined(MIN_VERSION_base)+formatException msg err = msg ++ ":" ++ format (displayException err)+#else formatException msg err = msg ++ ":" ++ format (show err)+#endif where format xs | isOneLine xs = " '" ++ xs ++ "'" | otherwise = "\n" ++ unlines [ " " ++ l | l <- lines xs ] @@ -443,6 +450,25 @@ then m else return () +-- | Performs an IO action every time a property is tested, after every test.+-- The IO action is allowed to depend on @TestProgress@, which contains information+-- regarding how testing is progressing.+--+-- Note: QC invokes callbacks before the internal state has been updated to reflect the+-- most recent test. The means that e.g. @currentPassed@ will, after the first test has+-- been executed, still show 0.+withProgress :: Testable prop => (TestProgress -> IO ()) -> prop -> Property+withProgress m =+ callback $ PostTest NotCounterexample $ \st _r ->+ let tp = TestProgress { currentPassed = numSuccessTests st+ , currentDiscarded = numDiscardedTests st+ , maxTests = maxSuccessTests st+ , currentShrinks = numSuccessShrinks st+ , currentFailedShrinks = numTryShrinks st+ , currentTotalShrinks = numTotTryShrinks st+ }+ in m tp+ -- | Prints out the generated test case every time the property is tested. -- Only variables quantified over /inside/ the 'verbose' are printed. --@@ -497,9 +523,20 @@ -- > quickCheck (withMaxSuccess 1000 p) -- -- will test @p@ up to 1000 times.+{-# DEPRECATED withMaxSuccess "Use withNumTests instead" #-} withMaxSuccess :: Testable prop => Int -> prop -> Property-withMaxSuccess n = n `seq` mapTotalResult (\res -> res{ maybeNumTests = Just n })+withMaxSuccess = withNumTests +-- | Configures how many times a property will be tested.+--+-- For example,+--+-- > quickCheck (withNumTests 1000 p)+--+-- will test @p@ up to 1000 times.+withNumTests :: Testable prop => Int -> prop -> Property+withNumTests n = n `seq` mapTotalResult (\res -> res{ maybeNumTests = Just n })+ -- | Configures how many times a property is allowed to be discarded before failing. -- -- For example,@@ -525,8 +562,9 @@ withMaxSize n = n `seq` mapTotalResult (\res -> res{ maybeMaxTestSize = Just n }) #ifndef NO_TYPEABLE--- | Return a value in the 'witnesses' field of the 'Result' returned by 'quickCheckResult'. Witnesses--- are returned outer-most first.+-- | Return a value in the 'Test.QuickCheck.witnesses' field of the 'Result'+-- returned by 'Test.QuickCheck.quickCheckResult'. Witnesses are returned+-- outer-most first. -- -- In ghci, for example: --@@ -659,6 +697,7 @@ #ifndef NO_DEEPSEQ s `deepseq` #endif+ b `seq` mapTotalResult $ \res -> res { classes = (s, b):classes res } @@ -765,7 +804,7 @@ mapTotalResult $ \res -> res { tables = [(key, value) | value <- values] ++ tables res } --- | Checks that the values in a given 'table' appear a certain proportion of+-- | Checks that the values in a given @table@ appear a certain proportion of -- the time. A call to 'coverTable' @table@ @[(x1, p1), ..., (xn, pn)]@ asserts -- that of the values in @table@, @x1@ should appear at least @p1@ percent of -- the time that @table@ appears, @x2@ at least @p2@ percent of the time that@@ -774,7 +813,7 @@ -- __Note:__ If the coverage check fails, QuickCheck prints out a warning, but -- the property does /not/ fail. To make the property fail, use 'checkCoverage'. ----- Continuing the example from the 'tabular' combinator...+-- Continuing the example from the 'tabulate' combinator... -- -- > data Command = LogIn | LogOut | SendMessage String deriving (Data, Show) -- > prop_chatroom :: [Command] -> Property@@ -858,7 +897,8 @@ onTimeout timeoutResult n = mapRoseResult f where f rose = ioRose $ do- let m `orError` x = fmap (fromMaybe x) m+ let orError :: IO (Maybe a) -> a -> IO a+ m `orError` x = fmap (fromMaybe x) m MkRose res roses <- timeout n (reduceRose rose) `orError` return timeoutResult res' <- timeout n (protectResult (return res)) `orError`@@ -908,8 +948,8 @@ unProperty $ shrinking shrinker x pf --- | Nondeterministic choice: 'p1' '.&.' 'p2' picks randomly one of--- 'p1' and 'p2' to test. If you test the property 100 times it+-- | Nondeterministic choice: @p1@ '.&.' @p2@ picks randomly one of+-- @p1@ and @p2@ to test. If you test the property 100 times it -- makes 100 random choices. (.&.) :: (Testable prop1, Testable prop2) => prop1 -> prop2 -> Property p1 .&. p2 =@@ -919,7 +959,7 @@ counterexample (if b then "LHS" else "RHS") $ if b then property p1 else property p2 --- | Conjunction: 'p1' '.&&.' 'p2' passes if both 'p1' and 'p2' pass.+-- | Conjunction: @p1@ '.&&.' @p2@ passes if both @p1@ and @p2@ pass. (.&&.) :: (Testable prop1, Testable prop2) => prop1 -> prop2 -> Property p1 .&&. p2 = conjoin [property p1, property p2] @@ -957,7 +997,7 @@ classes = classes result ++ classes r, tables = tables result ++ tables r } --- | Disjunction: 'p1' '.||.' 'p2' passes unless 'p1' and 'p2' simultaneously fail.+-- | Disjunction: @p1@ '.||.' @p2@ passes unless @p1@ and @p2@ simultaneously fail. (.||.) :: (Testable prop1, Testable prop2) => prop1 -> prop2 -> Property p1 .||. p2 = disjoin [property p1, property p2]
src/Test/QuickCheck/Random.hs view
@@ -26,17 +26,25 @@ instance Read QCGen where readsPrec n xs = [(QCGen g, ys) | (g, ys) <- readsPrec n xs] -instance RandomGen QCGen where+splitImpl :: QCGen -> (QCGen, QCGen) #ifdef NO_SPLITMIX- split (QCGen g) =+splitImpl (QCGen g) = case split g of (g1, g2) -> (QCGen g1, QCGen g2)- genRange (QCGen g) = genRange g- next = wrapQCGen next #else- split (QCGen g) =+splitImpl (QCGen g) = case splitSMGen g of (g1, g2) -> (QCGen g1, QCGen g2)+#endif++instance RandomGen QCGen where+#if !MIN_VERSION_random(1,3,0)+ split = splitImpl+#endif+#ifdef NO_SPLITMIX+ genRange (QCGen g) = genRange g+ next = wrapQCGen next+#else genRange _ = (minBound, maxBound) next = wrapQCGen nextInt @@ -47,10 +55,17 @@ genWord64 = wrapQCGen genWord64 genWord32R r = wrapQCGen (genWord32R r) genWord64R r = wrapQCGen (genWord64R r)- genShortByteString n = wrapQCGen (genShortByteString n)+#if MIN_VERSION_random(1,3,0)+ genShortByteString n = wrapQCGen (uniformShortByteString n) #endif #endif+#endif +#if MIN_VERSION_random(1,3,0)+instance SplitGen QCGen where+ splitGen = splitImpl+#endif+ {-# INLINE wrapQCGen #-} #ifdef NO_SPLITMIX wrapQCGen :: (StdGen -> (a, StdGen)) -> (QCGen -> (a, QCGen))@@ -80,8 +95,8 @@ left, right :: a -> a instance Splittable QCGen where- left = fst . split- right = snd . split+ left = fst . splitImpl+ right = snd . splitImpl -- 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
src/Test/QuickCheck/State.hs view
@@ -63,35 +63,49 @@ -- ^ total number of failed shrinking steps } --- | The statistical parameters used by 'checkCoverage'.+-- | The statistical parameters used by 'Test.QuickCheck.checkCoverage'. data Confidence = Confidence { certainty :: Integer,- -- ^ How certain 'checkCoverage' must be before the property fails.- -- If the coverage requirement is met, and the certainty parameter is @n@,- -- then you should get a false positive at most one in @n@ runs of QuickCheck.- -- The default value is @10^9@.+ -- ^ How certain 'Test.QuickCheck.checkCoverage' must be before the property+ -- fails. If the coverage requirement is met, and the certainty parameter is+ -- @n@, then you should get a false positive at most one in @n@ runs of+ -- QuickCheck. The default value is @10^9@. --- -- Lower values will speed up 'checkCoverage' at the cost of false- -- positives.+ -- Lower values will speed up 'Test.QuickCheck.checkCoverage' at the cost of+ -- false positives. --- -- If you are using 'checkCoverage' as part of a test suite, you should- -- be careful not to set @certainty@ too low. If you want, say, a 1% chance- -- of a false positive during a project's lifetime, then @certainty@ should- -- be set to at least @100 * m * n@, where @m@ is the number of uses of- -- 'cover' in the test suite, and @n@ is the number of times you expect the- -- test suite to be run during the project's lifetime. The default value- -- is chosen to be big enough for most projects.+ -- If you are using 'Test.QuickCheck.checkCoverage' as part of a test suite,+ -- you should be careful not to set @certainty@ too low. If you want, say, a+ -- 1% chance of a false positive during a project's lifetime, then+ -- certainty@ should be set to at least @100 * m * n@, where @m@ is the+ -- number of uses of 'Test.QuickCheck.cover' in the test suite, and @n@ is+ -- the number of times you expect the test suite to be run during the+ -- project's lifetime. The default value is chosen to be big enough for most+ -- projects. tolerance :: Double- -- ^ For statistical reasons, 'checkCoverage' will not reject coverage- -- levels that are only slightly below the required levels.+ -- ^ For statistical reasons, 'Test.QuickCheck.checkCoverage' will not+ -- reject coverage levels that are only slightly below the required levels. -- If the required level is @p@ then an actual level of @tolerance * p@ -- will be accepted. The default value is @0.9@. --- -- Lower values will speed up 'checkCoverage' at the cost of not detecting- -- minor coverage violations.+ -- Lower values will speed up 'Test.QuickCheck.checkCoverage' at the cost of+ -- not detecting minor coverage violations. } deriving Show++-- | TestProgress, contains information that might be interesting to external+-- libraries, e.g. Tasty. From this it is possible to install your own callbacks+-- that reports e.g. progress.+data TestProgress+ = TestProgress+ { currentPassed :: Int -- ^ Number of tests passed so far+ , currentDiscarded :: Int -- ^ Number of discared tests so far+ , maxTests :: Int -- ^ Number of tests to execute+ , currentShrinks :: Int -- ^ Number of successful shrinking steps+ , currentFailedShrinks :: Int -- ^ Number of failed shrinking steps since last successful one+ , currentTotalShrinks :: Int -- ^ Total number of failed shrinking steps+ } deriving Show -------------------------------------------------------------------------- -- the end.
src/Test/QuickCheck/Test.hs view
@@ -21,7 +21,6 @@ import qualified Test.QuickCheck.State as S 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@@ -177,10 +176,10 @@ , maxShrinks = maxBound } --- | Tests a property and prints the results to 'stdout'.+-- | Tests a property and prints the results to 'System.IO.stdout'. -- -- By default up to 100 tests are performed, which may not be enough--- to find all bugs. To run more tests, use 'withMaxSuccess'.+-- to find all bugs. To run more tests, use 'withNumTests'. -- -- If you want to get the counterexample as a Haskell value, -- rather than just printing it, try the@@ -190,15 +189,15 @@ quickCheck :: Testable prop => prop -> IO () quickCheck p = quickCheckWith stdArgs p --- | Tests a property, using test arguments, and prints the results to 'stdout'.+-- | Tests a property, using test arguments, and prints the results to 'System.IO.stdout'. quickCheckWith :: Testable prop => Args -> prop -> IO () quickCheckWith args p = quickCheckWithResult args p >> return () --- | Tests a property, produces a test result, and prints the results to 'stdout'.+-- | Tests a property, produces a test result, and prints the results to 'System.IO.stdout'. quickCheckResult :: Testable prop => prop -> IO Result quickCheckResult p = quickCheckWithResult stdArgs p --- | Tests a property, using test arguments, produces a test result, and prints the results to 'stdout'.+-- | Tests a property, using test arguments, produces a test result, and prints the results to 'System.IO.stdout'. quickCheckWithResult :: Testable prop => Args -> prop -> IO Result quickCheckWithResult a p = withState a (\s -> test s (property p))@@ -258,7 +257,7 @@ clamp :: Ord a => a -> (a, a) -> a clamp x (l, h) = max l (min x h) --- | Tests a property and prints the results and all test cases generated to 'stdout'.+-- | Tests a property and prints the results and all test cases generated to 'System.IO.stdout'. -- This is just a convenience function that means the same as @'quickCheck' . 'verbose'@. -- -- Note: for technical reasons, the test case is printed out /after/@@ -267,7 +266,7 @@ verboseCheck :: Testable prop => prop -> IO () verboseCheck p = quickCheck (verbose p) --- | Tests a property, using test arguments, and prints the results and all test cases generated to 'stdout'.+-- | Tests a property, using test arguments, and prints the results and all test cases generated to 'System.IO.stdout'. -- This is just a convenience function that combines 'quickCheckWith' and 'verbose'. -- -- Note: for technical reasons, the test case is printed out /after/@@ -276,7 +275,7 @@ verboseCheckWith :: Testable prop => Args -> prop -> IO () verboseCheckWith args p = quickCheckWith args (verbose p) --- | Tests a property, produces a test result, and prints the results and all test cases generated to 'stdout'.+-- | Tests a property, produces a test result, and prints the results and all test cases generated to 'System.IO.stdout'. -- This is just a convenience function that combines 'quickCheckResult' and 'verbose'. -- -- Note: for technical reasons, the test case is printed out /after/@@ -285,7 +284,7 @@ verboseCheckResult :: Testable prop => prop -> IO Result verboseCheckResult p = quickCheckResult (verbose p) --- | Tests a property, using test arguments, produces a test result, and prints the results and all test cases generated to 'stdout'.+-- | Tests a property, using test arguments, produces a test result, and prints the results and all test cases generated to 'System.IO.stdout'. -- This is just a convenience function that combines 'quickCheckWithResult' and 'verbose'. -- -- Note: for technical reasons, the test case is printed out /after/@@ -299,9 +298,9 @@ test :: State -> Property -> IO Result test st prop- | finishedSuccessfully st = doneTesting st prop- | finishedInsufficientCoverage st = failCoverage st prop- | tooManyDiscards st = giveUp st prop+ | finishedSuccessfully st = doneTesting st+ | finishedInsufficientCoverage st = failCoverage st+ | tooManyDiscards st = giveUp st | otherwise = runATest st prop finishedSuccessfully :: State -> Bool@@ -352,8 +351,8 @@ | (_, _, tot, n, p) <- allCoverage st ] coverageKnownInsufficient _ = False -failCoverage :: State -> Property -> IO Result-failCoverage st prop =+failCoverage :: State -> IO Result+failCoverage st = -- The last test wasn't actually successful, as the coverage failed -- also this prevents an off-by-one error in the printing runATest st{numSuccessTests = numSuccessTests st - 1}@@ -361,8 +360,8 @@ (paragraphs [theLabels, theTables]) where (theLabels, theTables) = labelsAndTables st -doneTesting :: State -> Property -> IO Result-doneTesting st _f+doneTesting :: State -> IO Result+doneTesting st | expected st == False = do putPart (terminal st) ( bold ("*** Failed!")@@ -383,8 +382,8 @@ theOutput <- terminalOutput (terminal st) return (k (numSuccessTests st) (numDiscardedTests st) (S.labels st) (S.classes st) (S.tables st) theOutput) -giveUp :: State -> Property -> IO Result-giveUp st _f =+giveUp :: State -> IO Result+giveUp st = do -- CALLBACK gave_up? putPart (terminal st) ( bold ("*** Gave up!")@@ -403,10 +402,13 @@ } showTestCount :: State -> String-showTestCount st =- number (numSuccessTests st) "test"- ++ concat [ "; " ++ show (numDiscardedTests st) ++ " discarded"- | numDiscardedTests st > 0+showTestCount st = formatTestCount (numSuccessTests st) (numDiscardedTests st)++formatTestCount :: Int -> Int -> String+formatTestCount succeeded discarded =+ number succeeded "test"+ ++ concat [ "; " ++ show discarded ++ " discarded"+ | discarded > 0 ] runATest :: State -> Property -> IO Result@@ -423,9 +425,10 @@ MkRose res ts <- protectRose (reduceRose (unProp (unGen (unProperty prop) rnd1 size))) res <- callbackPostTest st res - let continue break st'+ let continue :: (State -> IO Result) -> State -> IO Result+ continue break st' | abort res = break $ updateState st'- | otherwise = test $ updateState st'+ | otherwise = test (updateState st') prop updateState st0 = addNewOptions $ st0{ randomSeed = rnd2 } @@ -456,14 +459,14 @@ do continue doneTesting stC{ numSuccessTests = numSuccessTests st + 1 , numRecentlyDiscardedTests = 0- } prop+ } MkResult{ok = Nothing} -> -- discarded test do continue giveUp -- Don't add coverage info from this test st{ numDiscardedTests = numDiscardedTests st + 1 , numRecentlyDiscardedTests = numRecentlyDiscardedTests st + 1- } prop+ } MkResult{ok = Just False} -> -- failed test do (numShrinks, totFailed, lastFailed, res) <- foundFailure (addNewOptions stC) res ts@@ -495,7 +498,7 @@ #endif } where- (rnd1,rnd2) = split (randomSeed st)+ (rnd1,rnd2) = splitImpl (randomSeed st) failureSummary :: State -> P.Result -> String failureSummary st res = fst (failureSummaryAndReason st res)
+ test-mhs view
@@ -0,0 +1,25 @@+#!/bin/sh++set -e++mcabal -r install++die() {+ echo "TEST FAILED"+ exit 1+}++dotest() {+ cat >Main.hs <<EOF+import $1+main = $2+EOF+ mhs Main.hs -oMain && ./Main | tee mhs.output+ grep -q "$3" mhs.output || die+}++# Simple tests+dotest Test.QuickCheck 'quickCheck $ \xs -> reverse (reverse xs) === (xs :: [Int])' "OK, passed 100 tests."+dotest Test.QuickCheck 'quickCheck $ \xs -> reverse xs === (xs :: [Int])' "\[0,1\]"+echo+echo 'All tests passed!'
+ tests/CollectDataTypes.hs view
@@ -0,0 +1,199 @@+{-# LANGUAGE TemplateHaskell, RecordWildCards, DeriveLift, TupleSections, CPP, TypeOperators #-}+module CollectDataTypes where++import Language.Haskell.TH+import Language.Haskell.TH.Syntax+import Language.Haskell.TH.Ppr+import Language.Haskell.Interpreter hiding (lift)+import Data.Maybe+import Data.List+import System.Process+import Data.List.Split+import Control.Monad+import Control.Monad.Trans.Maybe+import Control.Monad.IO.Class+import Text.Printf+import Data.Either+import Data.Char+import Data.Function+import Test.QuickCheck+import Test.QuickCheck.Function++data DataType =+ DataType {+ dt_package :: String,+ dt_module :: String,+ dt_type :: String }+ deriving (Show, Lift)++getPackageDataTypes :: String -> IO [DataType]+getPackageDataTypes pkg = do+ mods <- filter isValidModule <$> getPackageModules pkg+ typess <- mapM getModuleDataTypes mods+ return [DataType pkg mod typ | (mod, types) <- zip mods typess, typ <- types]++getPackageModules :: String -> IO [String]+getPackageModules pkg =+ concatMap (parseWords . words) . splitOn ", " . unwords . words <$> readProcess cmd args ""+ where+ cmd:args = ["ghc-pkg", "field", pkg, "exposed-modules", "--simple-output"]+ parseWords [mod, "from", _] = [mod]+ parseWords xs = xs++getModuleDataTypes :: String -> IO [String]+getModuleDataTypes mod = do+ putStrLn mod+ Right names <- runInterpreter $ getModuleExports mod+ return [x | Data x _ <- names]++haskellName :: DataType -> String+haskellName DataType{..} = printf "%s.%s" dt_module (stripParens dt_type)+ where+ stripParens = reverse . dropWhile (== ')') . reverse . dropWhile (== '(')++dataTypeType :: DataType -> Q (Maybe Type)+dataTypeType dt = do+ mname <- lookupTypeName (haskellName dt)+ case mname of+ Nothing -> return Nothing+ Just name -> Just <$> reifyType name++typeArity :: Type -> Maybe Int+typeArity (AppT (AppT ArrowT StarT) kind) = succ <$> typeArity kind+typeArity StarT = return 0+typeArity _ = Nothing++createProperties :: String -> Q [Dec]+createProperties pkg = do+ datatypes0 <- runIO (getPackageDataTypes pkg)+ let datatypes = [ dt | dt <- datatypes0, not $ haskellName dt `elem` typeBlacklist ]+ let mkImport dt = printf "import %s -- for %s" (dt_module dt) (dt_type dt)+ missingModules <- fmap (map mkImport . nubBy ((==) `on` dt_module)) $ filterM (\ dt -> isNothing <$> dataTypeType dt) datatypes+ unless (null missingModules) $ error ("Missing the following imports:\n" ++ unlines missingModules)+ namesAndDecs <- fmap concat $ mapM createProperty datatypes+ let (allNames, props) = unzip namesAndDecs+ allPropsDec <- [d| allProps =+ $(pure $ ListE [ TupE [Just (LitE (StringL $ nameBase name)), Just (VarE name)]+ | name <- allNames ]+ )+ |]+ return $ allPropsDec ++ props++createProperty :: DataType -> Q [(Name, Dec)]+createProperty dt = do+ mtype <- dataTypeType dt+ -- TODO: monad?!+ case mtype of+ Nothing -> error $ "Can't find type in scope " ++ show dt+ Just typ -> case typeArity typ of+ Nothing -> pure []+ Just arity -> do+ Just name <- lookupTypeName (haskellName dt)+ Just int <- lookupTypeName "Int"+ nm <- newName ("prop_" ++ filter isAlphaNum (haskellName dt))+ nmCo <- newName ("prop_co_" ++ filter isAlphaNum (haskellName dt))+ nmFunction <- newName ("prop_function_" ++ filter isAlphaNum (haskellName dt))+ let propName = pure $ VarP nm+ let propNameCo = pure $ VarP nmCo+ let propNameFunction = pure $ VarP nmFunction+ let ty = pure $ foldl AppT (ConT name) $ replicate arity (ConT int)+ dArbitrary <- map (nm,) <$> [d| $propName = forAllBlind (arbitrary :: Gen $ty) (\ x -> x `seq` True) |]+ dCoArbitrary <- map (nmCo,) <$> [d| $propNameCo = forAllBlind (arbitrary :: Gen ($ty -> Integer)) (\ x -> x `seq` True) |]+ dFunction <- map (nmFunction,) <$> [d| $propNameFunction = forAllBlind (arbitrary :: Gen ($ty :-> Integer)) (\ x -> x `seq` True) |]+ return $ dArbitrary ++ dCoArbitrary ++ dFunction++typeBlacklist :: [String]+typeBlacklist = [ "Prelude.IO"+ , "Prelude.ReadS"+ , "Prelude.ShowS"+ , "System.IO.IO"+ , "System.IO.Error.IOError"+ , "Prelude.IOError"+ , "Data.Kind.Type"+ , "Data.Array.Byte.MutableByteArray"+ , "Data.IORef.IORef"+ , "Data.Kind.Constraint"+ , "Data.Unique.Unique"+ , "Data.STRef.STRef"+ , "Data.STRef.Lazy.STRef"+ , "Data.STRef.Strict.STRef"+ , "Data.Void.Void"+ , "Data.Proxy.KProxy"+ , "Data.Monoid.Endo"+ , "Data.Semigroup.Endo"+ , "Data.List.[]" -- This is buggy and annoying+ , "System.IO.HandlePosn"+ , "System.IO.Handle"+ , "Text.Printf.FieldFormatter" -- This is a function type and it+ -- requires an annoying coarbitrary instance+ , "Text.Printf.ModifierParser"+ , "Text.Show.ShowS"+ ] +++ -- These are phantom types used for indexing+ [ "Data.Fixed.E" ++ show i | i <- [0,1,2,3,6,9,12] ] +++#if MIN_VERSION_base(4,15,0)+ -- Exists but is deprecated+ [ "Data.Semigroup.Option" ] +++#endif+ -- TODO: Some controversial ones?+ [ "System.IO.Error.IOErrorType" ] +++ -- Some higher order types we ignore for the sake of CoArbitrary and Function issues+ [ "System.Console.GetOpt.OptDescr"+ , "System.Console.GetOpt.ArgOrder"+ , "System.Console.GetOpt.ArgDescr"+ ] +++ -- System specific and, likewise, not easily doable in Function+ [ "System.IO.TextEncoding" ] +++ -- Ignored for `Function` because the test monomorphises to `Int`. fixme.+ [ "Data.Complex.Complex" ]+++++modulePrefixBlacklist :: [String]+modulePrefixBlacklist = [ "GHC"+ , "Foreign"+ , "Control.Exception"+ -- Exports things like MVar etc+ , "Control.Concurrent"+ -- Exports ST and RealWorld that we can't support+ , "Control.Monad.ST"+ -- Existential wrapper around a Typeable thing, could+ -- be supported but would be a bit artificially+ -- limited to wrapping a bunch of types we can list+ , "Data.Dynamic"+ -- We _could_ support this, but it would result in+ -- the same problem as with Dynamic+ , "Data.Typeable"+ , "Type.Reflection"+ -- System.Mem.Weak and System.Mem.Stable export+ -- pointer types we don't support+ , "System.Mem"+ -- Exports an exception+ , "System.Timeout"+ -- Exports types, but not the constructors (or ways of+ -- creating them, e.g. Number). No feasible way to+ -- create meaningful generator+ , "Text.Read"+ -- Old generics implementation that doesn't fit nicely+ -- with arbitrary, as it has the same kind of problem+ -- that Typeable and Dynamic face+ , "Data.Data"+ -- Platform specific types that one could implement but+ -- would be tricky to keep consistent and correct+ -- across a number of platforms, esp. since we don't+ -- have good CI tests for them+ , "System.Posix"+ -- This exports a bunch of combinators whose only real+ -- role is to build a parser of an opaque type,+ -- consequently there isn't some super-interesting+ -- useful work you can do with it and it should be OK+ -- not to provide instances for it+ , "Text.ParserCombinators.ReadP"+ -- Slightly controversial, but this is only ignored for+ -- the sake of CoArbitrary and Function+ , "Data.Functor.Contravariant"+ ]++isValidModule :: String -> Bool+isValidModule mod = not $ any (`isPrefixOf` mod) modulePrefixBlacklist
tests/DiscardRatio.hs view
@@ -49,3 +49,8 @@ putStrLn "\nExpecting success (discard ratio 40): x < 50 ==> True" quickCheckYes $ withDiscardRatio 40 p50 quickCheckYesWith stdArgs{maxDiscardRatio = 40} p50++ -- Annoying interactions of discard and cover+ quickCheckYes $ forAllBlind (oneof [return True, return discard]) $ \ b -> cover 10 b "b" True+ quickCheck $ cover 10 discard "b" True+ quickCheck $ classify discard "b" True
tests/GCoArbitraryExample.hs view
@@ -17,7 +17,7 @@ prop_coarbitrary (Fun _ f) = expectFailure $- withMaxSuccess 1000 $+ withNumTests 1000 $ f (C1 (2::Int)) `elem` [0, 1 :: Int] return []
tests/Generators.hs view
@@ -29,7 +29,7 @@ path p (Path xs) = all p xs somePath :: (a -> Bool) -> Path a -> Property-somePath p = expectFailure . withMaxSuccess 1000 . path (not . p)+somePath p = expectFailure . withNumTests 1000 . path (not . p) newtype Extremal a = Extremal { getExtremal :: a } deriving (Show, Eq, Ord, Num, Enum, Real, Integral) @@ -139,7 +139,7 @@ reachesBound :: (Bounded a, Integral a, Arbitrary a) => a -> Property-reachesBound x = withMaxSuccess 1000 (expectFailure (x < 3 * (maxBound `div` 4)))+reachesBound x = withNumTests 1000 (expectFailure (x < 3 * (maxBound `div` 4))) prop_reachesBound_Int8 = reachesBound :: Int8 -> Property prop_reachesBound_Int16 = reachesBound :: Int16 -> Property
tests/Misc.hs view
@@ -26,7 +26,7 @@ prop_maxSize = withMaxSize 10 (forAll (arbitrary :: Gen Int) $ \ x -> abs x < 10) prop_cover :: Property-prop_cover = withMaxSuccess 1000+prop_cover = withNumTests 1000 $ checkCoverage $ forAll (arbitrary :: Gen Int) $ \ x -> cover 5 (x > 0) "positive" True
+ tests/Monoids.hs view
@@ -0,0 +1,146 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE ConstraintKinds #-}++#if __GLASGOW_HASKELL__ >= 800+{-# OPTIONS_GHC -Wno-orphans #-}+#endif+{-# LANGUAGE FlexibleInstances #-}++module Main (main) where++#ifndef NO_SEMIGROUP_CLASS+import Data.List.NonEmpty+import Data.Semigroup (Semigroup (..))+#else+import Data.Monoid (Monoid (..), (<>))+#endif++import Test.QuickCheck++#ifdef NO_SEMIGROUP_CLASS+type Semigroup = Monoid+sconcat :: Monoid a => [a] -> a+sconcat = mconcat+#endif++instance Arbitrary Every where+ arbitrary = oneof [ pure $ Every True+ , pure $ Every False+ , pure $ Every (counterexample "False" False)+ , pure $ Every (counterexample "True" True)+ , pure $ Every (ioProperty (return True))+ , pure $ Every (ioProperty (return False))+ , pure $ Every (checkCoverage $ cover 100 True "" True)+ , pure $ Every (checkCoverage $ cover 100 True "" False)+ , pure $ Every (checkCoverage $ cover 100 False "" False)+ ]+++instance Arbitrary Some where+ arbitrary = oneof [ pure $ Some True+ , pure $ Some False+ , pure $ Some (counterexample "False" False)+ , pure $ Some (counterexample "True" True)+ , pure $ Some (ioProperty (return True))+ , pure $ Some (ioProperty (return False))+ , pure $ Some (checkCoverage $ cover 100 True "" True)+ , pure $ Some (checkCoverage $ cover 100 True "" False)+ , pure $ Some (checkCoverage $ cover 100 False "" True)+ , pure $ Some (checkCoverage $ cover 100 False "" False)+ ]+++newtype Fail a = Fail a++instance Arbitrary (Fail Every) where+ arbitrary = oneof [ Fail <$> (arbitrary :: Gen Every)+ , pure $ Fail $ Every (checkCoverage $ cover 100 False "" True)+ ]+++check_associative_law :: (Testable p, Semigroup p) => Blind p -> Blind p -> Blind p -> Property+check_associative_law (Blind a) (Blind b) (Blind c) = ioProperty $ do+ x <- isSuccess <$> quickCheckWithResult args (a <> (b <> c))+ y <- isSuccess <$> quickCheckWithResult args ((a <> b) <> c)+ return (x == y)+++#ifndef NO_SEMIGROUP_SUPERCLASS+check_unit_law :: (Testable p, Monoid p) => Blind p -> Property+#else+check_unit_law :: (Testable p, Monoid p, Semigroup p) => Blind p -> Property+#endif+check_unit_law (Blind a) = ioProperty $ do+ x <- isSuccess <$> quickCheckWithResult args (a <> mempty)+ y <- isSuccess <$> quickCheckWithResult args (mempty <> a)+ z <- isSuccess <$> quickCheckWithResult args a+ return (x == y .&&. y == z)+++#ifndef NO_SEMIGROUP_CLASS+check_sconcat_law :: (Testable p, Semigroup p) => Blind p -> Blind p -> Property+check_sconcat_law (Blind a) (Blind b) = ioProperty $ do+ x <- isSuccess <$> quickCheckWithResult args (sconcat $ a :| [b])+ y <- isSuccess <$> quickCheckWithResult args (a <> b)+ return (x == y)+#endif+++#ifndef NO_SEMIGROUP_SUPERCLASS+check_mconcat_law :: (Testable p, Monoid p) => Blind p -> Blind p -> Property+#else+check_mconcat_law :: (Testable p, Monoid p, Semigroup p) => Blind p -> Blind p -> Property+#endif+check_mconcat_law (Blind a) (Blind b) = ioProperty $ do+ x <- isSuccess <$> quickCheckWithResult args (mconcat [a, b])+ y <- isSuccess <$> quickCheckWithResult args (a <> b)+ return (x == y)+++--+-- Auxiliary definitions+--++args :: Args+args = stdArgs { chatty = False, maxShrinks = 0 }++--+-- Properties+--++prop_every_associative :: Blind Every -> Blind Every -> Blind Every -> Property+prop_every_associative = check_associative_law++prop_every_unit :: Blind Every -> Property+prop_every_unit = check_unit_law++prop_every_unit_fail :: Blind (Fail Every) -> Property+prop_every_unit_fail (Blind (Fail a)) =+ expectFailure $ check_unit_law (Blind a)++#ifndef NO_SEMIGROUP_CLASS+prop_every_sconcat_law :: Blind Every -> Blind Every -> Property+prop_every_sconcat_law = check_sconcat_law+#endif++prop_every_mconcat_law :: Blind Every -> Blind Every -> Property+prop_every_mconcat_law = check_mconcat_law++prop_some_associative :: Blind Some -> Blind Some -> Blind Some -> Property+prop_some_associative = check_associative_law++prop_some_unit :: Blind Some -> Property+prop_some_unit = check_unit_law++#ifndef NO_SEMIGROUP_CLASS+prop_some_sconcat_law :: Blind Some -> Blind Some -> Property+prop_some_sconcat_law = check_sconcat_law+#endif++prop_some_mconcat_law :: Blind Some -> Blind Some -> Property+prop_some_mconcat_law = check_mconcat_law++return []+main = do True <- $quickCheckAll; return ()+
+ tests/RunCollectDataTypes.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE TemplateHaskell, CPP #-}+{-# OPTIONS_GHC -ddump-splices #-}+import CollectDataTypes+import Language.Haskell.TH+import Test.QuickCheck.All+import Test.QuickCheck++import Control.Applicative+import Control.Arrow+import Control.Concurrent+import Control.Concurrent.Chan+import Control.Concurrent.MVar+import Control.Concurrent.QSem+import Control.Concurrent.QSemN+import Control.Exception+import Control.Exception.Base+import Control.Monad.ST+import Control.Monad.ST.Lazy+import Control.Monad.ST.Strict+#if defined(MIN_VERSION_base)+#if MIN_VERSION_base(4,17,0)+import Data.Array.Byte+#endif+#endif+import Data.Bits+import Data.Bool+import Data.Char+import Data.Complex+import Data.Data+import Data.Dynamic+import Data.Either+import Data.Fixed+import Data.Functor.Compose+import Data.Functor.Const+import Data.Functor.Contravariant+import Data.Functor.Identity+import Data.Functor.Product+import Data.Functor.Sum+import Data.IORef+import Data.Int+import Data.Kind+import Data.List.NonEmpty+import Data.Maybe+import Data.Monoid+import Data.Ord+import Data.Proxy+import Data.Ratio+import Data.STRef+import Data.STRef.Lazy+import Data.STRef.Strict+import Data.Semigroup+import Data.String+import Data.Tuple+import Data.Type.Bool+import Data.Type.Coercion+import Data.Type.Equality+#if defined(MIN_VERSION_base)+#if MIN_VERSION_base(4,16,0)+import Data.Type.Ord+#endif+#endif+import Data.Typeable+import Data.Unique+import Data.Version+import Data.Void+import Data.Word+import Numeric.Natural+import System.Console.GetOpt+import System.Exit+import System.IO+import System.IO.Error+import System.Mem.StableName+import System.Mem.Weak+import System.Posix.Internals+import System.Posix.Types+import System.Timeout+import Text.ParserCombinators.ReadP+import Text.ParserCombinators.ReadPrec+import Text.Printf+import Text.Read+import Text.Read.Lex+import Text.Show+import Type.Reflection+import Type.Reflection.Unsafe+import Unsafe.Coerce++$(createProperties "base")++main = runQuickCheckAll allProps quickCheckResult
tests/Terminal.hs view
@@ -63,7 +63,7 @@ -- * Anything written to stderr (presumably by putTemp) is erased prop_terminal :: [Command] -> Property prop_terminal cmds =- withMaxSuccess 1000 $ ioProperty $+ withNumTests 1000 $ ioProperty $ withPipe $ \stdout_read stdout_write -> withPipe $ \stderr_read stderr_write -> do out <- withHandleTerminal stdout_write (Just stderr_write) $ \tm -> do
+ tests/WithProgress.hs view
@@ -0,0 +1,68 @@+import Test.QuickCheck+import Test.QuickCheck.Monadic++import Data.IORef+import System.Exit (exitSuccess, exitFailure)+import Control.Monad (when)++main :: IO ()+main = do+ succ <- newIORef 0+ disc <- newIORef 0++ -- test 1 + quickCheck (propTestWithProgress succ)+ i <- readIORef succ+ when (i /= 99) exitFailure++ modifyIORef succ (const 0)++ -- test 2+ quickCheck (proptestWithProgressDiscard succ disc)+ i1 <- readIORef succ+ i2 <- readIORef disc+ putStrLn $ show i1+ putStrLn $ show i2+ when (i1 /= 0 || i2 /= 999) exitFailure++ modifyIORef succ (const 0)+ modifyIORef disc (const 0)++ -- test 3+ quickCheck (proptestWithProgressNotInstalled succ disc)+ i1 <- readIORef succ+ i2 <- readIORef disc+ putStrLn $ show i1+ putStrLn $ show i2+ when (i1 /= 0 || i2 /= 0) exitFailure++ exitSuccess++-- all these tests succeed, incrementing the counter every time+propTestWithProgress :: IORef Int -> Property+propTestWithProgress ref =+ forAll (arbitrary :: Gen Int) $ \n ->+ withProgress (\p -> modifyIORef ref (\_ -> currentPassed p))+ $ n == n++-- all of these tests are discarded, never updating the currentPassed counter, but always+-- the currentDiscarded one.+proptestWithProgressDiscard :: IORef Int -> IORef Int -> Property+proptestWithProgressDiscard succ disc =+ forAll (arbitrary :: Gen Int) $ \n ->+ withProgress (\p -> do+ modifyIORef succ (\_ -> currentPassed p)+ modifyIORef disc (\_ -> currentDiscarded p))+ $ n > 1000 ==>+ n == n++-- The callback is installed after the test on n, meaning that since all tests are+-- discarded, it will never be called. It will never be executed.+proptestWithProgressNotInstalled :: IORef Int -> IORef Int -> Property+proptestWithProgressNotInstalled succ disc =+ forAll (arbitrary :: Gen Int) $ \n ->+ n > 1000 ==>+ withProgress (\p -> do+ modifyIORef succ (\_ -> currentPassed p)+ modifyIORef disc (\_ -> currentDiscarded p))+ $ n == n