Portability | portable |
---|---|
Maintainer | cabal-devel@haskell.org |
This module defines the detailed test suite interface which makes it possible to expose individual tests to Cabal or other test agents.
- newtype Options = Options [(String, String)]
- lookupOption :: Read r => String -> Options -> r
- class TestOptions t where
- data Test
- pure :: PureTestable p => p -> Test
- impure :: ImpureTestable i => i -> Test
- data Result
- class TestOptions t => ImpureTestable t where
- class TestOptions t => PureTestable t where
Example
The following terms are used carefully throughout this file:
- test interface
- The interface provided by this module.
- test agent
- A program used by package users to coordinates the running of tests and the reporting of their results.
- test framework
- A package used by software authors to specify tests, such as QuickCheck or HUnit.
Test frameworks are obligated to supply, at least, instances of the
TestOptions
and ImpureTestable
classes. It is preferred that test
frameworks implement PureTestable
whenever possible, so that test agents
have an assurance that tests can be safely run in parallel.
Test agents that allow the user to specify options should avoid setting
options not listed by the options
method. Test agents should use check
before running tests with non-default options. Test frameworks must
implement a check
function that attempts to parse the given options safely.
The packages cabal-test-hunit, cabal-test-quickcheck1, and
cabal-test-quickcheck2 provide simple interfaces to these popular test
frameworks. An example from cabal-test-quickcheck2 is shown below. A
better implementation would eliminate the console output from QuickCheck's
built-in runner and provide an instance of PureTestable
instead of
ImpureTestable
.
import Control.Monad (liftM) import Data.Maybe (catMaybes, fromJust, maybe) import Data.Typeable (Typeable(..)) import qualified Distribution.TestSuite as Cabal import System.Random (newStdGen, next, StdGen) import qualified Test.QuickCheck as QC data QCTest = forall prop. QC.Testable prop => QCTest String prop test :: QC.Testable prop => String -> prop -> Cabal.Test test n p = Cabal.impure $ QCTest n p instance Cabal.TestOptions QCTest where name (QCTest n _) = n options _ = [ ("std-gen", typeOf (undefined :: String)) , ("max-success", typeOf (undefined :: Int)) , ("max-discard", typeOf (undefined :: Int)) , ("size", typeOf (undefined :: Int)) ] defaultOptions _ = do rng <- newStdGen return $ Cabal.Options $ [ ("std-gen", show rng) , ("max-success", show $ QC.maxSuccess QC.stdArgs) , ("max-discard", show $ QC.maxDiscard QC.stdArgs) , ("size", show $ QC.maxSize QC.stdArgs) ] check t (Cabal.Options opts) = catMaybes [ maybeNothing "max-success" ([] :: [(Int, String)]) , maybeNothing "max-discard" ([] :: [(Int, String)]) , maybeNothing "size" ([] :: [(Int, String)]) ] -- There is no need to check the parsability of "std-gen" -- because the Read instance for StdGen always succeeds. where maybeNothing n x = maybe Nothing (\str -> if reads str == x then Just n else Nothing) $ lookup n opts instance Cabal.ImpureTestable QCTest where runM (QCTest _ prop) o = catch go (return . Cabal.Error . show) where go = do result <- QC.quickCheckWithResult args prop return $ case result of QC.Success {} -> Cabal.Pass QC.GaveUp {}-> Cabal.Fail $ "gave up after " ++ show (QC.numTests result) ++ " tests" QC.Failure {} -> Cabal.Fail $ QC.reason result QC.NoExpectedFailure {} -> Cabal.Fail "passed (expected failure)" args = QC.Args { QC.replay = Just ( Cabal.lookupOption "std-gen" o , Cabal.lookupOption "size" o ) , QC.maxSuccess = Cabal.lookupOption "max-success" o , QC.maxDiscard = Cabal.lookupOption "max-discard" o , QC.maxSize = Cabal.lookupOption "size" o }
lookupOption :: Read r => String -> Options -> rSource
Read an option from the specified set of Options
. It is an error to
lookup an option that has not been specified. For this reason, test agents
should mappend
any Options
against the defaultOptions
for a test, so
the default value specified by the test framework will be used for any
otherwise-unspecified options.
class TestOptions t whereSource
The name of the test.
options :: t -> [(String, TypeRep)]Source
A list of the options a test recognizes. The name and TypeRep
are
provided so that test agents can ensure that user-specified options are
correctly typed.
defaultOptions :: t -> IO OptionsSource
The default options for a test. Test frameworks should provide a new random seed, if appropriate.
check :: t -> Options -> [String]Source
Try to parse the provided options. Return the names of unparsable options. This allows test agents to detect bad user-specified options.
Tests
Test
is a wrapper for pure and impure tests so that lists containing
arbitrary test types can be constructed.
pure :: PureTestable p => p -> TestSource
A convenient function for wrapping pure tests into Test
s.
impure :: ImpureTestable i => i -> TestSource
A convenient function for wrapping impure tests into Test
s.
Pass | indicates a successful test |
Fail String | indicates a test completed unsuccessfully;
the |
Error String | indicates a test that could not be completed due to some error; the test framework should provide a message indicating the nature of the error. |
class TestOptions t => ImpureTestable t whereSource
Class abstracting impure tests. Test frameworks should implement this
class only as a last resort for test types which actually require IO
.
In particular, tests that simply require pseudo-random number generation can
be implemented as pure tests.
class TestOptions t => PureTestable t whereSource
Class abstracting pure tests. Test frameworks should prefer to implement
this class over ImpureTestable
. A default instance exists so that any pure
test can be lifted into an impure test; when lifted, any exceptions are
automatically caught. Test agents that lift pure tests themselves must
handle exceptions.