smallcheck-0.6.1: A property-based testing library

MaintainerRoman Cheplyaka <roma@ro-che.info>
Safe HaskellSafe-Infered

Test.SmallCheck

Contents

Description

This module exports the main pieces of SmallCheck functionality.

For pointers to other sources of information about SmallCheck, please refer to the README at https://github.com/feuerbach/smallcheck/blob/master/README.md

Synopsis

Constructing tests

The simplest kind of test is a function (possibly of many arguments) returning Bool.

In addition, you can use the combinators shown below. For more advanced combinators, see Test.SmallCheck.Property.

class Testable a Source

Anything of a Testable type can be regarded as a "test"

Instances

data Property Source

Wrapper type for Testables

Instances

property :: Testable a => a -> PropertySource

Wrap a Testable into a Property

Existential quantification

Suppose we have defined a function

isPrefix :: Eq a => [a] -> [a] -> Bool

and wish to specify it by some suitable property. We might define

prop_isPrefix1 :: String -> String -> Bool
prop_isPrefix1 xs ys = isPrefix xs (xs++ys)

where xs and ys are universally quantified. This property is necessary but not sufficient for a correct isPrefix. For example, it is satisfied by the function that always returns True!

We can also test the following property, which involves an existentially quantified variable:

prop_isPrefix2 :: String -> String -> Property
prop_isPrefix2 xs ys = isPrefix xs ys ==> exists $ \xs' -> ys == xs++xs'

exists :: (Show a, Serial a, Testable b) => (a -> b) -> PropertySource

exists p holds iff it is possible to find an argument a (within the depth constraints!) satisfying the predicate p

exists1 :: (Show a, Serial a, Testable b) => (a -> b) -> PropertySource

Like exists, but additionally require the uniqueness of the argument satisfying the predicate

existsDeeperBy :: (Show a, Serial a, Testable b) => (Depth -> Depth) -> (a -> b) -> PropertySource

The default testing of existentials is bounded by the same depth as their context. This rule has important consequences. Just as a universal property may be satisfied when the depth bound is shallow but fail when it is deeper, so the reverse may be true for an existential property. So when testing properties involving existentials it may be appropriate to try deeper testing after a shallow failure. However, sometimes the default same-depth-bound interpretation of existential properties can make testing of a valid property fail at all depths. Here is a contrived but illustrative example:

prop_append1 :: [Bool] -> [Bool] -> Property
prop_append1 xs ys = exists $ \zs -> zs == xs++ys

existsDeeperBy transforms the depth bound by a given Depth -> Depth function:

prop_append2 :: [Bool] -> [Bool] -> Property
prop_append2 xs ys = existsDeeperBy (*2) $ \zs -> zs == xs++ys

exists1DeeperBy :: (Show a, Serial a, Testable b) => (Depth -> Depth) -> (a -> b) -> PropertySource

Like existsDeeperBy, but additionally require the uniqueness of the argument satisfying the predicate

Conditioning

(==>) :: Testable a => Bool -> a -> PropertySource

The ==> operator can be used to express a restricting condition under which a property should hold. For example, testing a propositional-logic module (see examples/logical), we might define:

prop_tautEval :: Proposition -> Environment -> Property
prop_tautEval p e =
  tautology p ==> eval p e

But here is an alternative definition:

prop_tautEval :: Proposition -> Property
prop_taut p =
  tautology p ==> \e -> eval p e

The first definition generates p and e for each test, whereas the second only generates e if the tautology p holds.

The second definition is far better as the test-space is reduced from PE to T'+TE where P, T, T' and E are the numbers of propositions, tautologies, non-tautologies and environments.

Running tests

The functions below can be used to run SmallCheck tests.

As an alternative, consider using test-framework package.

It allows to organize SmallCheck properties into a test suite (possibly together with HUnit or QuickCheck tests), apply timeouts, get nice statistics etc.

To use SmallCheck properties with test-framework, install test-framework-smallcheck package.

smallCheck :: Testable a => Depth -> a -> IO ()Source

Run series of tests using depth bounds 0..d, stopping if any test fails, and print a summary report or a counter-example.

depthCheck :: Testable a => Depth -> a -> IO ()Source

Same as smallCheck, but test for values of depth d only

smallCheckI :: Testable a => a -> IO ()Source

Interactive variant, asking the user whether testing should continue/go deeper after a failure/completed iteration.

Example session:

haskell> smallCheckI prop_append1
Depth 0:
  Completed 1 test(s) without failure.
  Deeper? y
Depth 1:
  Failed test no. 5. Test values follow.
  [True]
  [True]
  Continue? n
  Deeper? n
haskell>

type Depth = IntSource

Maximum depth of generated test values

For data values, it is the depth of nested constructor applications.

For functional values, it is both the depth of nested case analysis and the depth of results.