{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} #if __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE ConstraintKinds #-} #define HasCallStack_ HasCallStack => #else #define HasCallStack_ #endif -- | Basic definitions for the HUnit library. -- -- This module contains what you need to create assertions and test cases and -- combine them into test suites. -- -- This module also provides infrastructure for -- implementing test controllers (which are used to execute tests). -- See "Test.HUnit.Text" for a great example of how to implement a test -- controller. module Test.HUnit.Base ( -- ** Declaring tests Test(..), (~=?), (~?=), (~:), (~?), -- ** Making assertions assertFailure, {- from Test.HUnit.Lang: -} assertBool, assertEqual, assertString, Assertion, {- from Test.HUnit.Lang: -} (@=?), (@?=), (@?), -- ** Extending the assertion functionality Assertable(..), ListAssertable(..), AssertionPredicate, AssertionPredicable(..), Testable(..), -- ** Test execution -- $testExecutionNote State(..), Counts(..), Path, Node(..), testCasePaths, testCaseCount, ReportStart, ReportProblem, performTest ) where import Control.Monad (unless, foldM) import Data.CallStack -- Assertion Definition -- ==================== import Test.HUnit.Lang -- Conditional Assertion Functions -- ------------------------------- -- | Asserts that the specified condition holds. assertBool :: HasCallStack_ String -- ^ The message that is displayed if the assertion fails -> Bool -- ^ The condition -> Assertion assertBool :: HasCallStack => String -> Bool -> Assertion assertBool String msg Bool b = forall (f :: * -> *). Applicative f => Bool -> f () -> f () unless Bool b (forall a. HasCallStack => String -> IO a assertFailure String msg) -- | Signals an assertion failure if a non-empty message (i.e., a message -- other than @\"\"@) is passed. assertString :: HasCallStack_ String -- ^ The message that is displayed with the assertion failure -> Assertion assertString :: HasCallStack => String -> Assertion assertString String s = forall (f :: * -> *). Applicative f => Bool -> f () -> f () unless (forall (t :: * -> *) a. Foldable t => t a -> Bool null String s) (forall a. HasCallStack => String -> IO a assertFailure String s) -- Overloaded `assert` Function -- ---------------------------- -- | Allows the extension of the assertion mechanism. -- -- Since an 'Assertion' can be a sequence of @Assertion@s and @IO@ actions, -- there is a fair amount of flexibility of what can be achieved. As a rule, -- the resulting @Assertion@ should be the body of a 'TestCase' or part of -- a @TestCase@; it should not be used to assert multiple, independent -- conditions. -- -- If more complex arrangements of assertions are needed, 'Test's and -- 'Testable' should be used. class Assertable t where assert :: HasCallStack_ t -> Assertion instance Assertable () where assert :: HasCallStack => () -> Assertion assert = forall (m :: * -> *) a. Monad m => a -> m a return instance Assertable Bool where assert :: HasCallStack => Bool -> Assertion assert = HasCallStack => String -> Bool -> Assertion assertBool String "" instance (ListAssertable t) => Assertable [t] where assert :: HasCallStack => [t] -> Assertion assert = forall t. (ListAssertable t, HasCallStack) => [t] -> Assertion listAssert instance (Assertable t) => Assertable (IO t) where assert :: HasCallStack => IO t -> Assertion assert = (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= forall t. (Assertable t, HasCallStack) => t -> Assertion assert) -- | A specialized form of 'Assertable' to handle lists. class ListAssertable t where listAssert :: HasCallStack_ [t] -> Assertion instance ListAssertable Char where listAssert :: HasCallStack => String -> Assertion listAssert = HasCallStack => String -> Assertion assertString -- Overloaded `assertionPredicate` Function -- ---------------------------------------- -- | The result of an assertion that hasn't been evaluated yet. -- -- Most test cases follow the following steps: -- -- 1. Do some processing or an action. -- -- 2. Assert certain conditions. -- -- However, this flow is not always suitable. @AssertionPredicate@ allows for -- additional steps to be inserted without the initial action to be affected -- by side effects. Additionally, clean-up can be done before the test case -- has a chance to end. A potential work flow is: -- -- 1. Write data to a file. -- -- 2. Read data from a file, evaluate conditions. -- -- 3. Clean up the file. -- -- 4. Assert that the side effects of the read operation meet certain conditions. -- -- 5. Assert that the conditions evaluated in step 2 are met. type AssertionPredicate = IO Bool -- | Used to signify that a data type can be converted to an assertion -- predicate. class AssertionPredicable t where assertionPredicate :: t -> AssertionPredicate instance AssertionPredicable Bool where assertionPredicate :: Bool -> AssertionPredicate assertionPredicate = forall (m :: * -> *) a. Monad m => a -> m a return instance (AssertionPredicable t) => AssertionPredicable (IO t) where assertionPredicate :: IO t -> AssertionPredicate assertionPredicate = (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= forall t. AssertionPredicable t => t -> AssertionPredicate assertionPredicate) -- Assertion Construction Operators -- -------------------------------- infix 1 @?, @=?, @?= -- | Asserts that the condition obtained from the specified -- 'AssertionPredicable' holds. (@?) :: HasCallStack_ AssertionPredicable t => t -- ^ A value of which the asserted condition is predicated -> String -- ^ A message that is displayed if the assertion fails -> Assertion t predi @? :: forall t. (HasCallStack, AssertionPredicable t) => t -> String -> Assertion @? String msg = forall t. AssertionPredicable t => t -> AssertionPredicate assertionPredicate t predi forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= HasCallStack => String -> Bool -> Assertion assertBool String msg -- | Asserts that the specified actual value is equal to the expected value -- (with the expected value on the left-hand side). (@=?) :: HasCallStack_ (Eq a, Show a) => a -- ^ The expected value -> a -- ^ The actual value -> Assertion a expected @=? :: forall a. (HasCallStack, Eq a, Show a) => a -> a -> Assertion @=? a actual = forall a. (HasCallStack, Eq a, Show a) => String -> a -> a -> Assertion assertEqual String "" a expected a actual -- | Asserts that the specified actual value is equal to the expected value -- (with the actual value on the left-hand side). (@?=) :: HasCallStack_ (Eq a, Show a) => a -- ^ The actual value -> a -- ^ The expected value -> Assertion a actual @?= :: forall a. (HasCallStack, Eq a, Show a) => a -> a -> Assertion @?= a expected = forall a. (HasCallStack, Eq a, Show a) => String -> a -> a -> Assertion assertEqual String "" a expected a actual -- Test Definition -- =============== -- | The basic structure used to create an annotated tree of test cases. data Test -- | A single, independent test case composed. = TestCase Assertion -- | A set of @Test@s sharing the same level in the hierarchy. | TestList [Test] -- | A name or description for a subtree of the @Test@s. | TestLabel String Test instance Show Test where showsPrec :: Int -> Test -> ShowS showsPrec Int _ (TestCase Assertion _) = String -> ShowS showString String "TestCase _" showsPrec Int _ (TestList [Test] ts) = String -> ShowS showString String "TestList " forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. Show a => [a] -> ShowS showList [Test] ts showsPrec Int p (TestLabel String l Test t) = String -> ShowS showString String "TestLabel " forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> ShowS showString String l forall b c a. (b -> c) -> (a -> b) -> a -> c . Char -> ShowS showChar Char ' ' forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. Show a => Int -> a -> ShowS showsPrec Int p Test t -- Overloaded `test` Function -- -------------------------- -- | Provides a way to convert data into a @Test@ or set of @Test@. class Testable t where test :: HasCallStack_ t -> Test instance Testable Test where test :: HasCallStack => Test -> Test test = forall a. a -> a id instance (Assertable t) => Testable (IO t) where test :: HasCallStack => IO t -> Test test = Assertion -> Test TestCase forall b c a. (b -> c) -> (a -> b) -> a -> c . forall t. (Assertable t, HasCallStack) => t -> Assertion assert instance (Testable t) => Testable [t] where test :: HasCallStack => [t] -> Test test = [Test] -> Test TestList forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b. (a -> b) -> [a] -> [b] map forall t. (Testable t, HasCallStack) => t -> Test test -- Test Construction Operators -- --------------------------- infix 1 ~?, ~=?, ~?= infixr 0 ~: -- | Creates a test case resulting from asserting the condition obtained -- from the specified 'AssertionPredicable'. (~?) :: HasCallStack_ AssertionPredicable t => t -- ^ A value of which the asserted condition is predicated -> String -- ^ A message that is displayed on test failure -> Test t predi ~? :: forall t. (HasCallStack, AssertionPredicable t) => t -> String -> Test ~? String msg = Assertion -> Test TestCase (t predi forall t. (HasCallStack, AssertionPredicable t) => t -> String -> Assertion @? String msg) -- | Shorthand for a test case that asserts equality (with the expected -- value on the left-hand side, and the actual value on the right-hand -- side). (~=?) :: HasCallStack_ (Eq a, Show a) => a -- ^ The expected value -> a -- ^ The actual value -> Test a expected ~=? :: forall a. (HasCallStack, Eq a, Show a) => a -> a -> Test ~=? a actual = Assertion -> Test TestCase (a expected forall a. (HasCallStack, Eq a, Show a) => a -> a -> Assertion @=? a actual) -- | Shorthand for a test case that asserts equality (with the actual -- value on the left-hand side, and the expected value on the right-hand -- side). (~?=) :: HasCallStack_ (Eq a, Show a) => a -- ^ The actual value -> a -- ^ The expected value -> Test a actual ~?= :: forall a. (HasCallStack, Eq a, Show a) => a -> a -> Test ~?= a expected = Assertion -> Test TestCase (a actual forall a. (HasCallStack, Eq a, Show a) => a -> a -> Assertion @?= a expected) -- | Creates a test from the specified 'Testable', with the specified -- label attached to it. -- -- Since 'Test' is @Testable@, this can be used as a shorthand way of attaching -- a 'TestLabel' to one or more tests. (~:) :: HasCallStack_ Testable t => String -> t -> Test String label ~: :: forall t. (HasCallStack, Testable t) => String -> t -> Test ~: t t = String -> Test -> Test TestLabel String label (forall t. (Testable t, HasCallStack) => t -> Test test t t) -- Test Execution -- ============== -- $testExecutionNote -- Note: the rest of the functionality in this module is intended for -- implementors of test controllers. If you just want to run your tests cases, -- simply use a test controller, such as the text-based controller in -- "Test.HUnit.Text". -- | A data structure that hold the results of tests that have been performed -- up until this point. data Counts = Counts { Counts -> Int cases, Counts -> Int tried, Counts -> Int errors, Counts -> Int failures :: Int } deriving (Counts -> Counts -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Counts -> Counts -> Bool $c/= :: Counts -> Counts -> Bool == :: Counts -> Counts -> Bool $c== :: Counts -> Counts -> Bool Eq, Int -> Counts -> ShowS [Counts] -> ShowS Counts -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Counts] -> ShowS $cshowList :: [Counts] -> ShowS show :: Counts -> String $cshow :: Counts -> String showsPrec :: Int -> Counts -> ShowS $cshowsPrec :: Int -> Counts -> ShowS Show, ReadPrec [Counts] ReadPrec Counts Int -> ReadS Counts ReadS [Counts] forall a. (Int -> ReadS a) -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a readListPrec :: ReadPrec [Counts] $creadListPrec :: ReadPrec [Counts] readPrec :: ReadPrec Counts $creadPrec :: ReadPrec Counts readList :: ReadS [Counts] $creadList :: ReadS [Counts] readsPrec :: Int -> ReadS Counts $creadsPrec :: Int -> ReadS Counts Read) -- | Keeps track of the remaining tests and the results of the performed tests. -- As each test is performed, the path is removed and the counts are -- updated as appropriate. data State = State { State -> Path path :: Path, State -> Counts counts :: Counts } deriving (State -> State -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: State -> State -> Bool $c/= :: State -> State -> Bool == :: State -> State -> Bool $c== :: State -> State -> Bool Eq, Int -> State -> ShowS [State] -> ShowS State -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [State] -> ShowS $cshowList :: [State] -> ShowS show :: State -> String $cshow :: State -> String showsPrec :: Int -> State -> ShowS $cshowsPrec :: Int -> State -> ShowS Show, ReadPrec [State] ReadPrec State Int -> ReadS State ReadS [State] forall a. (Int -> ReadS a) -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a readListPrec :: ReadPrec [State] $creadListPrec :: ReadPrec [State] readPrec :: ReadPrec State $creadPrec :: ReadPrec State readList :: ReadS [State] $creadList :: ReadS [State] readsPrec :: Int -> ReadS State $creadsPrec :: Int -> ReadS State Read) -- | Report generator for reporting the start of a test run. type ReportStart us = State -> us -> IO us -- | Report generator for reporting problems that have occurred during -- a test run. Problems may be errors or assertion failures. type ReportProblem us = Maybe SrcLoc -> String -> State -> us -> IO us -- | Uniquely describes the location of a test within a test hierarchy. -- Node order is from test case to root. type Path = [Node] -- | Composed into 'Path's. data Node = ListItem Int | Label String deriving (Node -> Node -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Node -> Node -> Bool $c/= :: Node -> Node -> Bool == :: Node -> Node -> Bool $c== :: Node -> Node -> Bool Eq, Int -> Node -> ShowS Path -> ShowS Node -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: Path -> ShowS $cshowList :: Path -> ShowS show :: Node -> String $cshow :: Node -> String showsPrec :: Int -> Node -> ShowS $cshowsPrec :: Int -> Node -> ShowS Show, ReadPrec Path ReadPrec Node Int -> ReadS Node ReadS Path forall a. (Int -> ReadS a) -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a readListPrec :: ReadPrec Path $creadListPrec :: ReadPrec Path readPrec :: ReadPrec Node $creadPrec :: ReadPrec Node readList :: ReadS Path $creadList :: ReadS Path readsPrec :: Int -> ReadS Node $creadsPrec :: Int -> ReadS Node Read) -- | Determines the paths for all 'TestCase's in a tree of @Test@s. testCasePaths :: Test -> [Path] testCasePaths :: Test -> [Path] testCasePaths Test t0 = Test -> Path -> [Path] tcp Test t0 [] where tcp :: Test -> Path -> [Path] tcp (TestCase Assertion _) Path p = [Path p] tcp (TestList [Test] ts) Path p = forall (t :: * -> *) a. Foldable t => t [a] -> [a] concat [ Test -> Path -> [Path] tcp Test t (Int -> Node ListItem Int n forall a. a -> [a] -> [a] : Path p) | (Test t,Int n) <- forall a b. [a] -> [b] -> [(a, b)] zip [Test] ts [Int 0..] ] tcp (TestLabel String l Test t) Path p = Test -> Path -> [Path] tcp Test t (String -> Node Label String l forall a. a -> [a] -> [a] : Path p) -- | Counts the number of 'TestCase's in a tree of @Test@s. testCaseCount :: Test -> Int testCaseCount :: Test -> Int testCaseCount (TestCase Assertion _) = Int 1 testCaseCount (TestList [Test] ts) = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a sum (forall a b. (a -> b) -> [a] -> [b] map Test -> Int testCaseCount [Test] ts) testCaseCount (TestLabel String _ Test t) = Test -> Int testCaseCount Test t -- | Performs a test run with the specified report generators. -- -- This handles the actual running of the tests. Most developers will want -- to use @HUnit.Text.runTestTT@ instead. A developer could use this function -- to execute tests via another IO system, such as a GUI, or to output the -- results in a different manner (e.g., upload XML-formatted results to a -- webservice). -- -- Note that the counts in a start report do not include the test case -- being started, whereas the counts in a problem report do include the -- test case just finished. The principle is that the counts are sampled -- only between test case executions. As a result, the number of test -- case successes always equals the difference of test cases tried and -- the sum of test case errors and failures. performTest :: ReportStart us -- ^ report generator for the test run start -> ReportProblem us -- ^ report generator for errors during the test run -> ReportProblem us -- ^ report generator for assertion failures during the test run -> us -> Test -- ^ the test to be executed -> IO (Counts, us) performTest :: forall us. ReportStart us -> ReportProblem us -> ReportProblem us -> us -> Test -> IO (Counts, us) performTest ReportStart us reportStart ReportProblem us reportError ReportProblem us reportFailure us initialUs Test initialT = do (State ss', us us') <- State -> us -> Test -> IO (State, us) pt State initState us initialUs Test initialT forall (f :: * -> *). Applicative f => Bool -> f () -> f () unless (forall (t :: * -> *) a. Foldable t => t a -> Bool null (State -> Path path State ss')) forall a b. (a -> b) -> a -> b $ forall a. HasCallStack => String -> a error String "performTest: Final path is nonnull" forall (m :: * -> *) a. Monad m => a -> m a return (State -> Counts counts State ss', us us') where initState :: State initState = State{ path :: Path path = [], counts :: Counts counts = Counts initCounts } initCounts :: Counts initCounts = Counts{ cases :: Int cases = Test -> Int testCaseCount Test initialT, tried :: Int tried = Int 0, errors :: Int errors = Int 0, failures :: Int failures = Int 0} pt :: State -> us -> Test -> IO (State, us) pt State ss us us (TestCase Assertion a) = do us us' <- ReportStart us reportStart State ss us us Result r <- Assertion -> IO Result performTestCase Assertion a case Result r of Result Success -> do forall (m :: * -> *) a. Monad m => a -> m a return (State ss', us us') Failure Maybe SrcLoc loc String m -> do us usF <- ReportProblem us reportFailure Maybe SrcLoc loc String m State ssF us us' forall (m :: * -> *) a. Monad m => a -> m a return (State ssF, us usF) Error Maybe SrcLoc loc String m -> do us usE <- ReportProblem us reportError Maybe SrcLoc loc String m State ssE us us' forall (m :: * -> *) a. Monad m => a -> m a return (State ssE, us usE) where c :: Counts c@Counts{ tried :: Counts -> Int tried = Int n } = State -> Counts counts State ss ss' :: State ss' = State ss{ counts :: Counts counts = Counts c{ tried :: Int tried = Int n forall a. Num a => a -> a -> a + Int 1 } } ssF :: State ssF = State ss{ counts :: Counts counts = Counts c{ tried :: Int tried = Int n forall a. Num a => a -> a -> a + Int 1, failures :: Int failures = Counts -> Int failures Counts c forall a. Num a => a -> a -> a + Int 1 } } ssE :: State ssE = State ss{ counts :: Counts counts = Counts c{ tried :: Int tried = Int n forall a. Num a => a -> a -> a + Int 1, errors :: Int errors = Counts -> Int errors Counts c forall a. Num a => a -> a -> a + Int 1 } } pt State ss us us (TestList [Test] ts) = forall (t :: * -> *) (m :: * -> *) b a. (Foldable t, Monad m) => (b -> a -> m b) -> b -> t a -> m b foldM (State, us) -> (Test, Int) -> IO (State, us) f (State ss, us us) (forall a b. [a] -> [b] -> [(a, b)] zip [Test] ts [Int 0..]) where f :: (State, us) -> (Test, Int) -> IO (State, us) f (State ss', us us') (Test t, Int n) = Node -> State -> us -> Test -> IO (State, us) withNode (Int -> Node ListItem Int n) State ss' us us' Test t pt State ss us us (TestLabel String label Test t) = Node -> State -> us -> Test -> IO (State, us) withNode (String -> Node Label String label) State ss us us Test t withNode :: Node -> State -> us -> Test -> IO (State, us) withNode Node node State ss0 us us0 Test t = do (State ss2, us us1) <- State -> us -> Test -> IO (State, us) pt State ss1 us us0 Test t forall (m :: * -> *) a. Monad m => a -> m a return (State ss2{ path :: Path path = Path path0 }, us us1) where path0 :: Path path0 = State -> Path path State ss0 ss1 :: State ss1 = State ss0{ path :: Path path = Node node forall a. a -> [a] -> [a] : Path path0 }