Safe Haskell | Safe |
---|---|
Language | Haskell98 |
Combinators for constructing properties.
Synopsis
- newtype Property = MkProperty {
- unProperty :: Gen Prop
- class Testable prop where
- data Discard = Discard
- morallyDubiousIOProperty :: Testable prop => IO prop -> Property
- ioProperty :: Testable prop => IO prop -> Property
- protect :: (AnException -> a) -> IO a -> IO a
- newtype Prop = MkProp {}
- data Rose a
- ioRose :: IO (Rose Result) -> Rose Result
- joinRose :: Rose (Rose a) -> Rose a
- reduceRose :: Rose Result -> IO (Rose Result)
- onRose :: (a -> [Rose a] -> Rose a) -> Rose a -> Rose a
- protectRose :: IO (Rose Result) -> IO (Rose Result)
- protectResults :: Rose Result -> Rose Result
- data Callback
- = PostTest CallbackKind (State -> Result -> IO ())
- | PostFinalFailure CallbackKind (State -> Result -> IO ())
- data CallbackKind
- data Result = MkResult {}
- exception :: String -> AnException -> Result
- formatException :: String -> AnException -> String
- protectResult :: IO Result -> IO Result
- succeeded :: Result
- failed :: Result
- rejected :: Result
- liftBool :: Bool -> Result
- mapResult :: Testable prop => (Result -> Result) -> prop -> Property
- mapTotalResult :: Testable prop => (Result -> Result) -> prop -> Property
- mapRoseResult :: Testable prop => (Rose Result -> Rose Result) -> prop -> Property
- mapProp :: Testable prop => (Prop -> Prop) -> prop -> Property
- mapSize :: Testable prop => (Int -> Int) -> prop -> Property
- shrinking :: Testable prop => (a -> [a]) -> a -> (a -> prop) -> Property
- noShrinking :: Testable prop => prop -> Property
- callback :: Testable prop => Callback -> prop -> Property
- counterexample :: Testable prop => String -> prop -> Property
- showCounterexample :: String -> IO String
- printTestCase :: Testable prop => String -> prop -> Property
- whenFail :: Testable prop => IO () -> prop -> Property
- whenFail' :: Testable prop => IO () -> prop -> Property
- verbose :: Testable prop => prop -> Property
- expectFailure :: Testable prop => prop -> Property
- once :: Testable prop => prop -> Property
- again :: Testable prop => prop -> Property
- withMaxSuccess :: Testable prop => Int -> prop -> Property
- label :: Testable prop => String -> prop -> Property
- collect :: (Show a, Testable prop) => a -> prop -> Property
- classify :: Testable prop => Bool -> String -> prop -> Property
- cover :: Testable prop => Bool -> Int -> String -> prop -> Property
- (==>) :: Testable prop => Bool -> prop -> Property
- within :: Testable prop => Int -> prop -> Property
- forAll :: (Show a, Testable prop) => Gen a -> (a -> prop) -> Property
- forAllShrink :: (Show a, Testable prop) => Gen a -> (a -> [a]) -> (a -> prop) -> Property
- (.&.) :: (Testable prop1, Testable prop2) => prop1 -> prop2 -> Property
- (.&&.) :: (Testable prop1, Testable prop2) => prop1 -> prop2 -> Property
- conjoin :: Testable prop => [prop] -> Property
- (.||.) :: (Testable prop1, Testable prop2) => prop1 -> prop2 -> Property
- disjoin :: Testable prop => [prop] -> Property
- (===) :: (Eq a, Show a) => a -> a -> Property
- total :: NFData a => a -> Property
Property and Testable types
The type of properties.
class Testable prop where Source #
The class of properties, i.e., types which QuickCheck knows how to test.
Typically a property will be a function returning Bool
or Property
.
If a property does no quantification, i.e. has no
parameters and doesn't use forAll
, it will only be tested once.
This may not be what you want if your property is an IO Bool
.
You can change this behaviour using the again
combinator.
Instances
Testable Bool Source # | |
Testable () Source # | |
Defined in Test.QuickCheck.Property | |
Testable Result Source # | |
Testable Prop Source # | |
Testable Discard Source # | |
Testable Property Source # | |
Testable prop => Testable (Gen prop) Source # | |
(Arbitrary a, Show a, Testable prop) => Testable (a -> prop) Source # | |
Defined in Test.QuickCheck.Property |
If a property returns Discard
, the current test case is discarded,
the same as if a precondition was false.
morallyDubiousIOProperty :: Testable prop => IO prop -> Property Source #
Deprecated: Use ioProperty
instead
Do I/O inside a property.
ioProperty :: Testable prop => IO prop -> Property Source #
Do I/O inside a property.
Warning: any random values generated inside of the argument to ioProperty
will not currently be shrunk. For best results, generate all random values
before calling ioProperty
.
Exception handling
Type Prop
type Rose
reduceRose :: Rose Result -> IO (Rose Result) Source #
Execute the IORose bits of a rose tree, returning a tree constructed by MkRose.
onRose :: (a -> [Rose a] -> Rose a) -> Rose a -> Rose a Source #
Apply a function to the outermost MkRose constructor of a rose tree. The function must be total!
protectRose :: IO (Rose Result) -> IO (Rose Result) Source #
Wrap a rose tree in an exception handler.
protectResults :: Rose Result -> Rose Result Source #
Wrap all the Results in a rose tree in exception handlers.
Result type
Different kinds of callbacks
PostTest CallbackKind (State -> Result -> IO ()) | Called just after a test |
PostFinalFailure CallbackKind (State -> Result -> IO ()) | Called with the final failing test-case |
data CallbackKind Source #
Counterexample | Affected by the |
NotCounterexample | Not affected by the |
The result of a single test.
MkResult | |
|
formatException :: String -> AnException -> String Source #
Lifting and mapping functions
Property combinators
mapSize :: Testable prop => (Int -> Int) -> prop -> Property Source #
Changes the maximum test case size for a property.
:: Testable prop | |
=> (a -> [a]) |
|
-> a | The original argument |
-> (a -> prop) | |
-> Property |
Shrinks the argument to a property if it fails. Shrinking is done automatically for most types. This function is only needed when you want to override the default behavior.
noShrinking :: Testable prop => prop -> Property Source #
Disables shrinking for a property altogether.
counterexample :: Testable prop => String -> prop -> Property Source #
Adds the given string to the counterexample if the property fails.
printTestCase :: Testable prop => String -> prop -> Property Source #
Deprecated: Use counterexample instead
Adds the given string to the counterexample if the property fails.
whenFail :: Testable prop => IO () -> prop -> Property Source #
Performs an IO
action after the last failure of a property.
whenFail' :: Testable prop => IO () -> prop -> Property Source #
Performs an IO
action every time a property fails. Thus,
if shrinking is done, this can be used to keep track of the
failures along the way.
verbose :: Testable prop => prop -> Property Source #
Prints out the generated testcase every time the property is tested.
Only variables quantified over inside the verbose
are printed.
expectFailure :: Testable prop => prop -> Property Source #
Indicates that a property is supposed to fail. QuickCheck will report an error if it does not fail.
once :: Testable prop => prop -> Property Source #
Modifies a property so that it only will be tested once.
Opposite of again
.
again :: Testable prop => prop -> Property Source #
Modifies a property so that it will be tested repeatedly.
Opposite of once
.
withMaxSuccess :: Testable prop => Int -> prop -> Property Source #
Configures how many times a property will be tested.
For example,
quickCheck (withMaxSuccess 1000 p)
will test p
up to 1000 times.
label :: Testable prop => String -> prop -> Property Source #
Attaches a label to a property. This is used for reporting test case distribution.
For example:
prop_reverse_reverse :: [Int] -> Property prop_reverse_reverse xs = label ("length of input is " ++ show (length xs)) $ reverse (reverse xs) === xs
>>>
quickCheck prop_reverse_reverse
+++ OK, passed 100 tests: 7% length of input is 7 6% length of input is 3 5% length of input is 4 4% length of input is 6 ...
collect :: (Show a, Testable prop) => a -> prop -> Property Source #
Attaches a label to a property. This is used for reporting test case distribution.
collect x = label (show x)
For example:
prop_reverse_reverse :: [Int] -> Property prop_reverse_reverse xs = collect (length xs) $ reverse (reverse xs) === xs
>>>
quickCheck prop_reverse_reverse
+++ OK, passed 100 tests: 7% 7 6% 3 5% 4 4% 6 ...
Records how many test cases satisfy a given condition.
For example:
prop_sorted_sort :: [Int] -> Property prop_sorted_sort xs = sorted xs ==> classify (length xs > 1) "non-trivial" $ sort xs === xs
>>>
quickCheck prop_sorted_sort
+++ OK, passed 100 tests (22% non-trivial).
:: Testable prop | |
=> Bool |
|
-> Int | The required percentage (0-100) of test cases. |
-> String | Label for the test case class. |
-> prop | |
-> Property |
Checks that at least the given proportion of successful test cases belong to the given class. Discarded tests (i.e. ones with a false precondition) do not affect coverage.
For example:
prop_sorted_sort :: [Int] -> Property prop_sorted_sort xs = sorted xs ==> cover (length xs > 1) 50 "non-trivial" $ sort xs === xs
>>>
quickCheck prop_sorted_sort
*** Insufficient coverage after 100 tests (only 24% non-trivial, not 50%).
(==>) :: Testable prop => Bool -> prop -> Property infixr 0 Source #
Implication for properties: The resulting property holds if
the first argument is False
(in which case the test case is discarded),
or if the given property holds.
within :: Testable prop => Int -> prop -> Property Source #
Considers a property failed if it does not complete within the given number of microseconds.
forAll :: (Show a, Testable prop) => Gen a -> (a -> prop) -> Property Source #
Explicit universal quantification: uses an explicitly given test case generator.
forAllShrink :: (Show a, Testable prop) => Gen a -> (a -> [a]) -> (a -> prop) -> Property Source #
Like forAll
, but tries to shrink the argument for failing test cases.
(.&.) :: (Testable prop1, Testable prop2) => prop1 -> prop2 -> Property infixr 1 Source #
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 infixr 1 Source #
Conjunction: p1
.&&.
p2
passes if both p1
and p2
pass.
(.||.) :: (Testable prop1, Testable prop2) => prop1 -> prop2 -> Property infixr 1 Source #
Disjunction: p1
.||.
p2
passes unless p1
and p2
simultaneously fail.