Safe Haskell | None |
---|---|
Language | Haskell98 |
Chell is a simple and intuitive library for automated testing. It natively
supports assertion-based testing, and can use companion libraries
such as chell-quickcheck
to support more complex testing strategies.
An example test suite, which verifies the behavior of artithmetic operators.
{-# LANGUAGE TemplateHaskell #-} import Test.Chell suite_Math :: Suite suite_Math =suite
"math" [ test_Addition , test_Subtraction ] test_Addition :: Test test_Addition =assertions
"addition" $ do $expect
(equal
(2 + 1) 3) $expect
(equal
(1 + 2) 3) test_Subtraction :: Test test_Subtraction =assertions
"subtraction" $ do $expect
(equal
(2 - 1) 1) $expect
(equal
(1 - 2) (-1)) main :: IO () main =defaultMain
[suite_Math]
$ ghc --make chell-example.hs $ ./chell-example PASS: 2 tests run, 2 tests passed
- defaultMain :: [Suite] -> IO ()
- data Suite
- suite :: String -> [Test] -> Suite
- suiteName :: Suite -> String
- suiteTests :: Suite -> [Test]
- class SuiteOrTest a
- skipIf :: SuiteOrTest a => Bool -> a -> a
- skipWhen :: SuiteOrTest a => IO Bool -> a -> a
- data Assertions a
- assertions :: String -> Assertions a -> Test
- class IsAssertion a
- data Assertion
- assertionPassed :: Assertion
- assertionFailed :: String -> Assertion
- assert :: Q Exp
- expect :: Q Exp
- die :: Q Exp
- trace :: Q Exp
- note :: String -> String -> Assertions ()
- afterTest :: IO () -> Assertions ()
- requireLeft :: Q Exp
- requireRight :: Q Exp
- equal :: (Show a, Eq a) => a -> a -> Assertion
- notEqual :: (Eq a, Show a) => a -> a -> Assertion
- equalWithin :: (Real a, Show a) => a -> a -> a -> Assertion
- just :: Maybe a -> Assertion
- nothing :: Show a => Maybe a -> Assertion
- left :: Show b => Either a b -> Assertion
- right :: Show a => Either a b -> Assertion
- throws :: Exception err => (err -> Bool) -> IO a -> IO Assertion
- throwsEq :: (Eq err, Exception err, Show err) => err -> IO a -> IO Assertion
- greater :: (Ord a, Show a) => a -> a -> Assertion
- greaterEqual :: (Ord a, Show a) => a -> a -> Assertion
- lesser :: (Ord a, Show a) => a -> a -> Assertion
- lesserEqual :: (Ord a, Show a) => a -> a -> Assertion
- sameItems :: (Foldable container, Show item, Ord item) => container item -> container item -> Assertion
- equalItems :: (Foldable container, Show item, Ord item) => container item -> container item -> Assertion
- class IsText a
- equalLines :: (Ord a, IsText a) => a -> a -> Assertion
- equalLinesWith :: Ord a => (a -> [String]) -> a -> a -> Assertion
- data Test
- test :: String -> (TestOptions -> IO TestResult) -> Test
- testName :: Test -> String
- runTest :: Test -> TestOptions -> IO TestResult
- data TestResult
- = TestPassed [(String, String)]
- | TestSkipped
- | TestFailed [(String, String)] [Failure]
- | TestAborted [(String, String)] String
- data Failure
- failure :: Failure
- failureLocation :: Failure -> Maybe Location
- failureMessage :: Failure -> String
- data Location
- location :: Location
- locationFile :: Location -> String
- locationModule :: Location -> String
- locationLine :: Location -> Maybe Integer
- data TestOptions
- defaultTestOptions :: TestOptions
- testOptionSeed :: TestOptions -> Int
- testOptionTimeout :: TestOptions -> Maybe Int
Main
defaultMain :: [Suite] -> IO () Source #
A simple default main function, which runs a list of tests and logs statistics to stdout.
Test suites
A suite is a named collection of tests.
Note: earlier versions of Chell permitted arbitrary nesting of test suites.
This feature proved too unwieldy, and was removed. A similar result can be
achieved with suiteTests
; see the documentation for suite
.
suite :: String -> [Test] -> Suite Source #
Define a new Suite
, with the given name and children.
Note: earlier versions of Chell permitted arbitrary nesting of test suites.
This feature proved too unwieldy, and was removed. A similar result can be
achieved with suiteTests
:
test_Addition :: Test test_Subtraction :: Test test_Show :: Test suite_Math :: Suite suite_Math =suite
"math" [ test_Addition , test_Subtraction ] suite_Prelude :: Suite suite_Prelude =suite
"prelude" ( [ test_Show ] ++ suiteTests suite_Math )
suiteName :: Suite -> String Source #
Get a suite's name. Suite names may be any string, but are typically plain ASCII so users can easily type them on the command line.
$ ghci chell-example.hs Ok, modules loaded: Main. *Main> suiteName tests_Math "math"
suiteTests :: Suite -> [Test] Source #
Get the full list of tests contained within this Suite
. Each test is
given its full name within the test hierarchy, where names are separated
by periods.
$ ghci chell-example.hs Ok, modules loaded: Main. *Main> suiteTests tests_Math [Test "math.addition",Test "math.subtraction"]
Skipping some tests
skipIf :: SuiteOrTest a => Bool -> a -> a Source #
Basic testing library
data Assertions a Source #
See assertions
.
assertions :: String -> Assertions a -> Test Source #
Convert a sequence of pass/fail assertions into a runnable test.
test_Equality :: Test test_Equality = assertions "equality" $ do $assert (1 == 1) $assert (equal 1 1)
class IsAssertion a Source #
runAssertion
IsAssertion Bool Source # | |
IsAssertion Assertion Source # | |
IsAssertion a => IsAssertion (IO a) Source # | |
A single pass/fail assertion. Failed assertions include an explanatory message.
assertionPassed :: Assertion Source #
See Assertion
.
note :: String -> String -> Assertions () Source #
Attach a note to a test run. Notes will be printed to stdout and included in reports, even if the test fails or aborts. Notes are useful for debugging failing tests.
afterTest :: IO () -> Assertions () Source #
Register an IO action to be run after the test completes. This action will run even if the test failed or aborted.
requireLeft :: Q Exp Source #
requireRight :: Q Exp Source #
Built-in assertions
Assert that two values are within some delta of each other.
throws :: Exception err => (err -> Bool) -> IO a -> IO Assertion Source #
Assert that some computation throws an exception matching the provided
predicate. This is mostly useful for exception types which do not have an
instance for Eq
, such as
.ErrorCall
throwsEq :: (Eq err, Exception err, Show err) => err -> IO a -> IO Assertion Source #
Assert that some computation throws an exception equal to the given exception. This is better than just checking that the correct type was thrown, because the test can also verify the exception contains the correct information.
greaterEqual :: (Ord a, Show a) => a -> a -> Assertion Source #
Assert a value is greater than or equal to another.
lesserEqual :: (Ord a, Show a) => a -> a -> Assertion Source #
Assert a value is less than or equal to another.
sameItems :: (Foldable container, Show item, Ord item) => container item -> container item -> Assertion Source #
Assert that two containers have the same items, in any order.
equalItems :: (Foldable container, Show item, Ord item) => container item -> container item -> Assertion Source #
Assert that two containers have the same items, in the same order.
Class for types which can be treated as text; see equalLines
.
toLines, unpack
equalLines :: (Ord a, IsText a) => a -> a -> Assertion Source #
Assert that two pieces of text are equal. This uses a diff algorithm to check line-by-line, so the error message will be easier to read on large inputs.
equalLinesWith :: Ord a => (a -> [String]) -> a -> a -> Assertion Source #
Variant of equalLines
which allows a user-specified line-splitting
predicate.
Custom test types
A Test
is, essentially, an IO action that returns a TestResult
. Tests
are aggregated into suites (see Suite
).
test :: String -> (TestOptions -> IO TestResult) -> Test Source #
Define a test, with the given name and implementation.
runTest :: Test -> TestOptions -> IO TestResult Source #
Run a test, wrapped in error handlers. This will return TestAborted
if
the test throws an exception or times out.
Test results
data TestResult Source #
The result of running a test.
To support future extensions to the testing API, any users of this module
who pattern-match against the TestResult
constructors should include a
default case. If no default case is provided, a warning will be issued.
TestPassed [(String, String)] | The test passed, and generated the given notes. |
TestSkipped | The test did not run, because it was skipped with |
TestFailed [(String, String)] [Failure] | The test failed, generating the given notes and failures. |
TestAborted [(String, String)] String | The test aborted with an error message, and generated the given notes. |
Failures
Contains details about a test failure.
failureLocation :: Failure -> Maybe Location Source #
If given, the location of the failing assertion, expectation, etc.
failureLocation
is a field accessor, and can be used to update
a Failure
value.
failureMessage :: Failure -> String Source #
If given, a message which explains why the test failed.
failureMessage
is a field accessor, and can be used to update
a Failure
value.
Failure locations
Contains details about a location in the test source file.
locationFile :: Location -> String Source #
A path to a source file, or empty if not provided.
locationFile
is a field accessor, and can be used to update
a Location
value.
locationModule :: Location -> String Source #
A Haskell module name, or empty if not provided.
locationModule
is a field accessor, and can be used to update
a Location
value.
locationLine :: Location -> Maybe Integer Source #
A line number, or Nothing if not provided.
locationLine
is a field accessor, and can be used to update
a Location
value.
Test options
data TestOptions Source #
Test options are passed to each test, and control details about how the test should be run.
defaultTestOptions :: TestOptions Source #
Default test options.
$ ghci Prelude> import Test.Chell Test.Chell> testOptionSeed defaultTestOptions 0 Test.Chell> testOptionTimeout defaultTestOptions Nothing
testOptionSeed :: TestOptions -> Int Source #
Get the RNG seed for this test run. The seed is generated once, in
defaultMain
, and used for all tests. It is also logged to reports
using a note.
When using defaultMain
, users may specify a seed using the
--seed
command-line option.
testOptionSeed
is a field accessor, and can be used to update
a TestOptions
value.
testOptionTimeout :: TestOptions -> Maybe Int Source #
An optional timeout, in millseconds. Tests which run longer than this timeout will be aborted.
When using defaultMain
, users may specify a timeout using the
--timeout
command-line option.
testOptionTimeout
is a field accessor, and can be used to update
a TestOptions
value.