quickcheck-with-counterexamples-1.0: Get counterexamples from QuickCheck as Haskell values

Safe HaskellNone
LanguageHaskell2010

Test.QuickCheck.Counterexamples

Contents

Description

This module extends QuickCheck so that it returns counterexamples as Haskell values instead of just printing them. To use it, import this module instead of Test.QuickCheck. The API and functionality are the same as normal QuickCheck; the only difference is that the return types of quickCheck (and related functions) include a counterexample.

Note that this module re-exports most functions from Test.QuickCheck. Those functions are not documented here! You will need to refer to the main Test.QuickCheck documentation when using this module.

Here is an example of getting counterexamples. Suppose we have the following property:

prop_reverse_append :: [Int] -> [Int] -> Property
prop_reverse_append xs ys =
  reverse (xs++ys) === reverse xs ++ reverse ys

If we look the type of quickCheck prop_reverse_append, we see that it returns a counterexample:

>>> :t quickCheck prop_reverse_append
quickCheck prop_reverse_append :: IO (Maybe ([Int] :&: [Int] :&: ()))

The Maybe is there because quickCheck will return Nothing if the property succeeds; :&: is a datatype of pairs.

If we run QuickCheck, we can get the counterexample as a normal Haskell value:

>>> Just (xs :&: ys :&: ()) <- quickCheck prop_reverse_append
*** Failed! Falsifiable (after 5 tests and 4 shrinks):
[0]
[1]
[1,0] /= [0,1]
>>> :t xs
xs :: [Int]
>>> xs
[0]
>>> ys
[1]

Here is how this module's API differs from normal QuickCheck, in more detail:

  • The Testable class now has an associated type Counterexample which describes the counterexample. Property is now a synonym for PropertyOf (), where PropertyOf cex represents a property with an associated counterexample cex. The QuickCheck property combinators preserve the counterexample, by returning PropertyOf instead of Property.
  • quickCheck and related functions return a Counterexample prop.
  • Finally, there are a couple of new combinators, documented below.

Synopsis

The PropertyOf type and Testable typeclass

newtype PropertyOf cex Source #

A property. cex is the type of counterexamples to the property.

Note that there is a Functor instance, which is useful when you want to manipulate the counterexample, e.g., to change its type. For example, when some branches of your property produce a counterexample and other branches do not, the types will not match up, but using fmap you can make the counterexample be a Maybe.

Constructors

MkProperty 

Fields

  • unProperty :: (cex -> IO ()) -> Property

    Implementation note: the property receives a callback to which it should pass the counterexample after shrinking.

Instances

Functor PropertyOf Source # 

Methods

fmap :: (a -> b) -> PropertyOf a -> PropertyOf b #

(<$) :: a -> PropertyOf b -> PropertyOf a #

Testable (PropertyOf cex) Source # 

Methods

property :: PropertyOf cex -> Property #

Testable (PropertyOf cex) Source # 

Associated Types

type Counterexample (PropertyOf cex) :: * Source #

type Counterexample (PropertyOf cex) Source # 
type Counterexample (PropertyOf cex) = cex

type Property = PropertyOf () Source #

A property which doesn't produce a counterexample.

type PropertyFrom prop = PropertyOf (Counterexample prop) Source #

A type synonym for the property which comes from a particular Testable instance.

class Testable prop => Testable prop where Source #

The class of properties, i.e. types which QuickCheck knows how to test.

Minimal complete definition

property

Associated Types

type Counterexample prop Source #

The type of counterexamples to the property.

Methods

property :: prop -> PropertyFrom prop Source #

Convert the property to a PropertyOf.

Instances

Testable Bool Source # 

Associated Types

type Counterexample Bool :: * Source #

Testable Property Source # 
Testable Discard Source # 

Associated Types

type Counterexample Discard :: * Source #

Testable prop => Testable (Gen prop) Source # 

Associated Types

type Counterexample (Gen prop) :: * Source #

Methods

property :: Gen prop -> PropertyFrom (Gen prop) Source #

Testable (PropertyOf cex) Source # 

Associated Types

type Counterexample (PropertyOf cex) :: * Source #

(Show a, Arbitrary a, Testable b) => Testable (a -> b) Source # 

Associated Types

type Counterexample (a -> b) :: * Source #

Methods

property :: (a -> b) -> PropertyFrom (a -> b) Source #

New functionality which is not in QuickCheck

data a :&: b infixr 6 Source #

A type of pairs. Used in counterexamples.

Constructors

a :&: b infixr 6 

Instances

(Eq b, Eq a) => Eq ((:&:) a b) Source # 

Methods

(==) :: (a :&: b) -> (a :&: b) -> Bool #

(/=) :: (a :&: b) -> (a :&: b) -> Bool #

(Ord b, Ord a) => Ord ((:&:) a b) Source # 

Methods

compare :: (a :&: b) -> (a :&: b) -> Ordering #

(<) :: (a :&: b) -> (a :&: b) -> Bool #

(<=) :: (a :&: b) -> (a :&: b) -> Bool #

(>) :: (a :&: b) -> (a :&: b) -> Bool #

(>=) :: (a :&: b) -> (a :&: b) -> Bool #

max :: (a :&: b) -> (a :&: b) -> a :&: b #

min :: (a :&: b) -> (a :&: b) -> a :&: b #

(Read b, Read a) => Read ((:&:) a b) Source # 

Methods

readsPrec :: Int -> ReadS (a :&: b) #

readList :: ReadS [a :&: b] #

readPrec :: ReadPrec (a :&: b) #

readListPrec :: ReadPrec [a :&: b] #

(Show b, Show a) => Show ((:&:) a b) Source # 

Methods

showsPrec :: Int -> (a :&: b) -> ShowS #

show :: (a :&: b) -> String #

showList :: [a :&: b] -> ShowS #

typedCounterexample :: Testable prop => a -> prop -> PropertyOf (a :&: Counterexample prop) Source #

Add a value to the counterexample.

onProperty :: Testable prop => (Property -> Property) -> prop -> PropertyFrom prop Source #

Lift an ordinary QuickCheck property combinator to one with counterexamples.

The standard QuickCheck combinators, updated to return counterexamples

forAll :: (Testable prop, Show a) => Gen a -> (a -> prop) -> PropertyOf (a :&: Counterexample prop) Source #

forAllShrink :: (Testable prop, Show a) => Gen a -> (a -> [a]) -> (a -> prop) -> PropertyOf (a :&: Counterexample prop) Source #

shrinking :: Testable prop => (a -> [a]) -> a -> (a -> prop) -> PropertyFrom prop Source #

(==>) :: Testable prop => Bool -> prop -> PropertyFrom prop infixr 0 Source #

(===) :: (Eq a, Show a) => a -> a -> Property infix 4 Source #

once :: Testable prop => prop -> PropertyFrom prop Source #

again :: Testable prop => prop -> PropertyFrom prop Source #

within :: Testable prop => Int -> prop -> PropertyFrom prop Source #

whenFail :: Testable prop => IO () -> prop -> PropertyFrom prop Source #

whenFail' :: Testable prop => IO () -> prop -> PropertyFrom prop Source #

label :: Testable prop => String -> prop -> PropertyFrom prop Source #

collect :: (Show a, Testable prop) => a -> prop -> PropertyFrom prop Source #

cover :: Testable prop => Bool -> Int -> String -> prop -> PropertyFrom prop Source #

mapSize :: Testable prop => (Int -> Int) -> prop -> PropertyFrom prop Source #