Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
This module provides assert-like functions for writing unit tests.
Synopsis
- assertBool :: HasCallStack => Bool -> IO ()
- assertBoolVerbose :: HasCallStack => String -> Bool -> IO ()
- assertEqual :: (Eq a, Show a, HasCallStack) => a -> a -> IO ()
- assertEqualVerbose :: (Eq a, Show a, HasCallStack) => String -> a -> a -> IO ()
- assertEqualPretty :: (Eq a, Pretty a, HasCallStack) => a -> a -> IO ()
- assertEqualPrettyVerbose :: (Eq a, Pretty a, HasCallStack) => String -> a -> a -> IO ()
- assertEqualNoShow :: (Eq a, HasCallStack) => a -> a -> IO ()
- assertEqualNoShowVerbose :: (Eq a, HasCallStack) => String -> a -> a -> IO ()
- assertNotEqual :: (Eq a, Show a, HasCallStack) => a -> a -> IO ()
- assertNotEqualVerbose :: (Eq a, Show a, HasCallStack) => String -> a -> a -> IO ()
- assertNotEqualPretty :: (Eq a, Pretty a, HasCallStack) => a -> a -> IO ()
- assertNotEqualPrettyVerbose :: (Eq a, Pretty a, HasCallStack) => String -> a -> a -> IO ()
- assertNotEqualNoShow :: (Eq a, HasCallStack) => a -> a -> IO ()
- assertNotEqualNoShowVerbose :: (Eq a, HasCallStack) => String -> a -> a -> IO ()
- assertListsEqualAsSets :: (Eq a, Show a, HasCallStack) => [a] -> [a] -> IO ()
- assertListsEqualAsSetsVerbose :: (Eq a, Show a, HasCallStack) => String -> [a] -> [a] -> IO ()
- assertNotEmpty :: HasCallStack => [a] -> IO ()
- assertNotEmptyVerbose :: HasCallStack => String -> [a] -> IO ()
- assertEmpty :: HasCallStack => [a] -> IO ()
- assertEmptyVerbose :: HasCallStack => String -> [a] -> IO ()
- assertElem :: (Eq a, Show a, HasCallStack) => a -> [a] -> IO ()
- assertElemVerbose :: (Eq a, Show a, HasCallStack) => String -> a -> [a] -> IO ()
- assertThrows :: (HasCallStack, Exception e) => a -> (e -> Bool) -> IO ()
- assertThrowsVerbose :: (HasCallStack, Exception e) => String -> a -> (e -> Bool) -> IO ()
- assertThrowsSome :: HasCallStack => a -> IO ()
- assertThrowsSomeVerbose :: HasCallStack => String -> a -> IO ()
- assertThrowsIO :: (HasCallStack, Exception e) => IO a -> (e -> Bool) -> IO ()
- assertThrowsIOVerbose :: (HasCallStack, Exception e) => String -> IO a -> (e -> Bool) -> IO ()
- assertThrowsSomeIO :: HasCallStack => IO a -> IO ()
- assertThrowsSomeIOVerbose :: HasCallStack => String -> IO a -> IO ()
- assertThrowsM :: (MonadBaseControl IO m, MonadIO m, Exception e, HasCallStack) => m a -> (e -> Bool) -> m ()
- assertThrowsMVerbose :: (MonadBaseControl IO m, MonadIO m, Exception e, HasCallStack) => String -> m a -> (e -> Bool) -> m ()
- assertThrowsSomeM :: (MonadBaseControl IO m, MonadIO m, HasCallStack) => m a -> m ()
- assertThrowsSomeMVerbose :: (MonadBaseControl IO m, MonadIO m, HasCallStack) => String -> m a -> m ()
- assertLeft :: (HasCallStack, Show b) => Either a b -> IO a
- assertLeftVerbose :: (Show b, HasCallStack) => String -> Either a b -> IO a
- assertLeftNoShow :: HasCallStack => Either a b -> IO a
- assertLeftNoShowVerbose :: HasCallStack => String -> Either a b -> IO a
- assertRight :: (HasCallStack, Show a) => Either a b -> IO b
- assertRightVerbose :: (Show a, HasCallStack) => String -> Either a b -> IO b
- assertRightNoShow :: HasCallStack => Either a b -> IO b
- assertRightNoShowVerbose :: HasCallStack => String -> Either a b -> IO b
- assertJust :: HasCallStack => Maybe a -> IO a
- assertJustVerbose :: HasCallStack => String -> Maybe a -> IO a
- assertNothing :: (HasCallStack, Show a) => Maybe a -> IO ()
- assertNothingVerbose :: (Show a, HasCallStack) => String -> Maybe a -> IO ()
- assertNothingNoShow :: HasCallStack => Maybe a -> IO ()
- assertNothingNoShowVerbose :: HasCallStack => String -> Maybe a -> IO ()
- assertFailure :: HasCallStack => String -> IO a
- unitTestPending :: String -> IO a
- unitTestPending' :: String -> IO a -> IO a
- subAssert :: (HasCallStack, MonadBaseControl IO m) => m a -> m a
- subAssertVerbose :: (HasCallStack, MonadBaseControl IO m) => String -> m a -> m a
- gassertBool :: (HasCallStack, AssertM m) => Bool -> m ()
- gassertBoolVerbose :: (HasCallStack, AssertM m) => String -> Bool -> m ()
- gassertEqual :: (Eq a, Show a, AssertM m, HasCallStack) => a -> a -> m ()
- gassertEqualVerbose :: (Eq a, Show a, AssertM m, HasCallStack) => String -> a -> a -> m ()
- gassertEqualPretty :: (Eq a, Pretty a, AssertM m, HasCallStack) => a -> a -> m ()
- gassertEqualPrettyVerbose :: (Eq a, Pretty a, AssertM m, HasCallStack) => String -> a -> a -> m ()
- gassertEqualNoShow :: (Eq a, AssertM m, HasCallStack) => a -> a -> m ()
- gassertEqualNoShowVerbose :: (Eq a, AssertM m, HasCallStack) => String -> a -> a -> m ()
- gassertNotEqual :: (Eq a, Show a, AssertM m, HasCallStack) => a -> a -> m ()
- gassertNotEqualVerbose :: (Eq a, Show a, AssertM m, HasCallStack) => String -> a -> a -> m ()
- gassertNotEqualPretty :: (Eq a, Pretty a, AssertM m, HasCallStack) => a -> a -> m ()
- gassertNotEqualPrettyVerbose :: (Eq a, Pretty a, AssertM m, HasCallStack) => String -> a -> a -> m ()
- gassertNotEqualNoShow :: (Eq a, AssertM m, HasCallStack) => a -> a -> m ()
- gassertNotEqualNoShowVerbose :: (Eq a, AssertM m, HasCallStack) => String -> a -> a -> m ()
- gassertListsEqualAsSets :: (Eq a, Show a, AssertM m, HasCallStack) => [a] -> [a] -> m ()
- gassertListsEqualAsSetsVerbose :: (Eq a, Show a, AssertM m, HasCallStack) => String -> [a] -> [a] -> m ()
- gassertNotEmpty :: (HasCallStack, AssertM m) => [a] -> m ()
- gassertNotEmptyVerbose :: (AssertM m, HasCallStack) => String -> [a] -> m ()
- gassertEmpty :: (HasCallStack, AssertM m) => [a] -> m ()
- gassertEmptyVerbose :: (AssertM m, HasCallStack) => String -> [a] -> m ()
- gassertElem :: (Eq a, Show a, AssertM m, HasCallStack) => a -> [a] -> m ()
- gassertElemVerbose :: (Eq a, Show a, AssertM m, HasCallStack) => String -> a -> [a] -> m ()
- gassertLeft :: (Show b, AssertM m, HasCallStack) => Either a b -> m a
- gassertLeftVerbose :: (Show b, AssertM m, HasCallStack) => String -> Either a b -> m a
- gassertLeftNoShow :: (HasCallStack, AssertM m) => Either a b -> m a
- gassertLeftNoShowVerbose :: (HasCallStack, AssertM m) => String -> Either a b -> m a
- gassertRight :: (Show a, AssertM m, HasCallStack) => Either a b -> m b
- gassertRightVerbose :: (Show a, AssertM m, HasCallStack) => String -> Either a b -> m b
- gassertRightNoShow :: (HasCallStack, AssertM m) => Either a b -> m b
- gassertRightNoShowVerbose :: (HasCallStack, AssertM m) => String -> Either a b -> m b
- gassertJust :: (HasCallStack, AssertM m) => Maybe a -> m a
- gassertJustVerbose :: (HasCallStack, AssertM m) => String -> Maybe a -> m a
- gassertNothing :: (Show a, AssertM m, HasCallStack) => Maybe a -> m ()
- gassertNothingVerbose :: (Show a, AssertM m, HasCallStack) => String -> Maybe a -> m ()
- gassertNothingNoShow :: (HasCallStack, AssertM m) => Maybe a -> m ()
- gassertNothingNoShowVerbose :: (HasCallStack, AssertM m) => String -> Maybe a -> m ()
- gassertFailure :: (HasCallStack, AssertM m) => String -> m a
- gsubAssert :: (HasCallStack, AssertM m) => m a -> m a
- gsubAssertVerbose :: (HasCallStack, AssertM m) => String -> m a -> m a
- data HUnitFailure
- hunitWrapperTests :: [(String, IO ())]
Assertions on Bool values
assertBool :: HasCallStack => Bool -> IO () Source #
assertBoolVerbose :: HasCallStack => String -> Bool -> IO () Source #
Equality assertions
assertEqual :: (Eq a, Show a, HasCallStack) => a -> a -> IO () Source #
assertEqualVerbose :: (Eq a, Show a, HasCallStack) => String -> a -> a -> IO () Source #
assertEqualPretty :: (Eq a, Pretty a, HasCallStack) => a -> a -> IO () Source #
Fail if the two values of type a
are not equal.
Use if a
is an instance of Pretty
.
assertEqualPrettyVerbose :: (Eq a, Pretty a, HasCallStack) => String -> a -> a -> IO () Source #
Fail if the two values of type a
are not equal, supplying
an additional message.
Use if a
is an instance of Pretty
.
assertEqualNoShow :: (Eq a, HasCallStack) => a -> a -> IO () Source #
assertEqualNoShowVerbose :: (Eq a, HasCallStack) => String -> a -> a -> IO () Source #
Inequality assertions
assertNotEqual :: (Eq a, Show a, HasCallStack) => a -> a -> IO () Source #
assertNotEqualVerbose :: (Eq a, Show a, HasCallStack) => String -> a -> a -> IO () Source #
assertNotEqualPretty :: (Eq a, Pretty a, HasCallStack) => a -> a -> IO () Source #
Fail if the two values of type a
are equal.
Use if a
is an instance of Pretty
.
assertNotEqualPrettyVerbose :: (Eq a, Pretty a, HasCallStack) => String -> a -> a -> IO () Source #
Fail if the two values of type a
are equal, supplying
an additional message.
Use if a
is an instance of Pretty
.
assertNotEqualNoShow :: (Eq a, HasCallStack) => a -> a -> IO () Source #
assertNotEqualNoShowVerbose :: (Eq a, HasCallStack) => String -> a -> a -> IO () Source #
Assertions on lists
assertListsEqualAsSets :: (Eq a, Show a, HasCallStack) => [a] -> [a] -> IO () Source #
Fail if the two given lists are not equal when considered as sets.
assertListsEqualAsSetsVerbose :: (Eq a, Show a, HasCallStack) => String -> [a] -> [a] -> IO () Source #
Fail if the two given lists are not equal when considered as sets, supplying an additional error message.
assertNotEmpty :: HasCallStack => [a] -> IO () Source #
Fail if the given list is empty.
assertNotEmptyVerbose :: HasCallStack => String -> [a] -> IO () Source #
Fail if the given list is empty, supplying an additional error message.
assertEmpty :: HasCallStack => [a] -> IO () Source #
Fail if the given list is not empty.
assertEmptyVerbose :: HasCallStack => String -> [a] -> IO () Source #
Fail if the given list is not empty, supplying an additional error message.
assertElem :: (Eq a, Show a, HasCallStack) => a -> [a] -> IO () Source #
Fail if the element given is not contained in the list.
assertElemVerbose :: (Eq a, Show a, HasCallStack) => String -> a -> [a] -> IO () Source #
Fail if the element given is not contained in the list, supplying an additional error message.
Assertions for exceptions
assertThrows :: (HasCallStack, Exception e) => a -> (e -> Bool) -> IO () Source #
Fail if evaluating the expression of type a
does not
throw an exception satisfying the given predicate (e -> Bool)
.
assertThrowsVerbose :: (HasCallStack, Exception e) => String -> a -> (e -> Bool) -> IO () Source #
Fail if evaluating the expression of type a
does not
throw an exception satisfying the given predicate (e -> Bool)
,
supplying an additional error message.
assertThrowsSome :: HasCallStack => a -> IO () Source #
Fail if evaluating the expression of type a
does not
throw any exception.
assertThrowsSomeVerbose :: HasCallStack => String -> a -> IO () Source #
Fail if evaluating the expression of type a
does not
throw any exception, supplying an additional error message.
assertThrowsIO :: (HasCallStack, Exception e) => IO a -> (e -> Bool) -> IO () Source #
Fail if executing the IO
action does not throw an exception satisfying the given predicate
(e -> Bool)
.
assertThrowsIOVerbose :: (HasCallStack, Exception e) => String -> IO a -> (e -> Bool) -> IO () Source #
Fail if executing the IO
action does not throw an exception satisfying the given predicate
(e -> Bool)
, supplying an additional error message.
assertThrowsSomeIO :: HasCallStack => IO a -> IO () Source #
Fail if executing the IO
action does not throw any exception.
assertThrowsSomeIOVerbose :: HasCallStack => String -> IO a -> IO () Source #
Fail if executing the IO
action does not throw any exception,
supplying an additional error message.
assertThrowsM :: (MonadBaseControl IO m, MonadIO m, Exception e, HasCallStack) => m a -> (e -> Bool) -> m () Source #
Fail if executing the m
action does not throw an exception satisfying the given predicate
(e -> Bool)
.
assertThrowsMVerbose :: (MonadBaseControl IO m, MonadIO m, Exception e, HasCallStack) => String -> m a -> (e -> Bool) -> m () Source #
Fail if executing the m
action does not throw an exception satisfying the given predicate
(e -> Bool)
, supplying an additional error message.
assertThrowsSomeM :: (MonadBaseControl IO m, MonadIO m, HasCallStack) => m a -> m () Source #
Fail if executing the m
action does not throw any exception.
assertThrowsSomeMVerbose :: (MonadBaseControl IO m, MonadIO m, HasCallStack) => String -> m a -> m () Source #
Fail if executing the m
action does not throw any exception,
supplying an additional error message.
Assertions on Either values
assertLeft :: (HasCallStack, Show b) => Either a b -> IO a Source #
assertLeftVerbose :: (Show b, HasCallStack) => String -> Either a b -> IO a Source #
assertLeftNoShow :: HasCallStack => Either a b -> IO a Source #
assertLeftNoShowVerbose :: HasCallStack => String -> Either a b -> IO a Source #
assertRight :: (HasCallStack, Show a) => Either a b -> IO b Source #
assertRightVerbose :: (Show a, HasCallStack) => String -> Either a b -> IO b Source #
assertRightNoShow :: HasCallStack => Either a b -> IO b Source #
assertRightNoShowVerbose :: HasCallStack => String -> Either a b -> IO b Source #
Assertions on Just values
assertJust :: HasCallStack => Maybe a -> IO a Source #
Fail if the given value is a Nothing.
assertJustVerbose :: HasCallStack => String -> Maybe a -> IO a Source #
Fail if the given value is a Nothing, supplying an additional error message.
assertNothing :: (HasCallStack, Show a) => Maybe a -> IO () Source #
assertNothingVerbose :: (Show a, HasCallStack) => String -> Maybe a -> IO () Source #
assertNothingNoShow :: HasCallStack => Maybe a -> IO () Source #
assertNothingNoShowVerbose :: HasCallStack => String -> Maybe a -> IO () Source #
General failure
assertFailure :: HasCallStack => String -> IO a Source #
Specialization of gassertFailure
to IO
.
Pending unit tests
unitTestPending :: String -> IO a Source #
Signals that the current unit test is pending.
unitTestPending' :: String -> IO a -> IO a Source #
Use unitTestPending' msg test
to mark the given test as pending
without removing it from the test suite and without deleting or commenting out the test code.
Sub assertions
subAssert :: (HasCallStack, MonadBaseControl IO m) => m a -> m a Source #
Use subAssert
if you want location information for the call site but the function
being called does not carry a HasCallStack
constraint.
subAssertVerbose :: (HasCallStack, MonadBaseControl IO m) => String -> m a -> m a Source #
Generalized assertions and failures in AssertM
The following definitions generalize the the monad in which assertions are executed.
Usually, assertions are executed in the IO
monad. The AssertM
monad
(see Test.Framework.AssertM) allows you to evaluate assertions also as pure functions.
Assertions on Bool values
gassertBool :: (HasCallStack, AssertM m) => Bool -> m () Source #
gassertBoolVerbose :: (HasCallStack, AssertM m) => String -> Bool -> m () Source #
Equality assertions
gassertEqual :: (Eq a, Show a, AssertM m, HasCallStack) => a -> a -> m () Source #
gassertEqualVerbose :: (Eq a, Show a, AssertM m, HasCallStack) => String -> a -> a -> m () Source #
gassertEqualPretty :: (Eq a, Pretty a, AssertM m, HasCallStack) => a -> a -> m () Source #
gassertEqualPrettyVerbose :: (Eq a, Pretty a, AssertM m, HasCallStack) => String -> a -> a -> m () Source #
gassertEqualNoShow :: (Eq a, AssertM m, HasCallStack) => a -> a -> m () Source #
gassertEqualNoShowVerbose :: (Eq a, AssertM m, HasCallStack) => String -> a -> a -> m () Source #
Inequality assertions
gassertNotEqual :: (Eq a, Show a, AssertM m, HasCallStack) => a -> a -> m () Source #
gassertNotEqualVerbose :: (Eq a, Show a, AssertM m, HasCallStack) => String -> a -> a -> m () Source #
gassertNotEqualPretty :: (Eq a, Pretty a, AssertM m, HasCallStack) => a -> a -> m () Source #
gassertNotEqualPrettyVerbose :: (Eq a, Pretty a, AssertM m, HasCallStack) => String -> a -> a -> m () Source #
gassertNotEqualNoShow :: (Eq a, AssertM m, HasCallStack) => a -> a -> m () Source #
gassertNotEqualNoShowVerbose :: (Eq a, AssertM m, HasCallStack) => String -> a -> a -> m () Source #
Assertions on lists
gassertListsEqualAsSets :: (Eq a, Show a, AssertM m, HasCallStack) => [a] -> [a] -> m () Source #
Fail in some AssertM
monad if the two given lists are not equal when considered as sets.
gassertListsEqualAsSetsVerbose :: (Eq a, Show a, AssertM m, HasCallStack) => String -> [a] -> [a] -> m () Source #
Fail in some AssertM
monad if the two given lists are not equal when considered as sets,
supplying an additional error message.
gassertNotEmpty :: (HasCallStack, AssertM m) => [a] -> m () Source #
Fail in some AssertM
monad if the given list is empty.
gassertNotEmptyVerbose :: (AssertM m, HasCallStack) => String -> [a] -> m () Source #
Fail in some AssertM
monad if the given list is empty, supplying an
additional error message.
gassertEmpty :: (HasCallStack, AssertM m) => [a] -> m () Source #
Fail in some AssertM
monad if the given list is not empty.
gassertEmptyVerbose :: (AssertM m, HasCallStack) => String -> [a] -> m () Source #
Fail in some AssertM
monad if the given list is not empty, supplying an
additional error message.
gassertElem :: (Eq a, Show a, AssertM m, HasCallStack) => a -> [a] -> m () Source #
Fail in some AssertM
monad if the element given is not contained in the list.
gassertElemVerbose :: (Eq a, Show a, AssertM m, HasCallStack) => String -> a -> [a] -> m () Source #
Fail in some AssertM
monad if the element given is not contained in the list, supplying
an additional error message.
Assertions on Either values
gassertLeft :: (Show b, AssertM m, HasCallStack) => Either a b -> m a Source #
gassertLeftVerbose :: (Show b, AssertM m, HasCallStack) => String -> Either a b -> m a Source #
gassertLeftNoShow :: (HasCallStack, AssertM m) => Either a b -> m a Source #
gassertLeftNoShowVerbose :: (HasCallStack, AssertM m) => String -> Either a b -> m a Source #
gassertRight :: (Show a, AssertM m, HasCallStack) => Either a b -> m b Source #
gassertRightVerbose :: (Show a, AssertM m, HasCallStack) => String -> Either a b -> m b Source #
gassertRightNoShow :: (HasCallStack, AssertM m) => Either a b -> m b Source #
gassertRightNoShowVerbose :: (HasCallStack, AssertM m) => String -> Either a b -> m b Source #
Assertions on Just values
gassertJust :: (HasCallStack, AssertM m) => Maybe a -> m a Source #
Fail in some AssertM
monad if the given value is a Nothing.
gassertJustVerbose :: (HasCallStack, AssertM m) => String -> Maybe a -> m a Source #
Fail in some AssertM
monad if the given value is a Nothing, supplying an additional
error message.
gassertNothing :: (Show a, AssertM m, HasCallStack) => Maybe a -> m () Source #
gassertNothingVerbose :: (Show a, AssertM m, HasCallStack) => String -> Maybe a -> m () Source #
gassertNothingNoShow :: (HasCallStack, AssertM m) => Maybe a -> m () Source #
gassertNothingNoShowVerbose :: (HasCallStack, AssertM m) => String -> Maybe a -> m () Source #
General failure
gassertFailure :: (HasCallStack, AssertM m) => String -> m a Source #
Fail with the given reason in some AssertM
monad.
Sub assertions
gsubAssert :: (HasCallStack, AssertM m) => m a -> m a Source #
gsubAssertVerbose :: (HasCallStack, AssertM m) => String -> m a -> m a Source #
HUnit re-exports
data HUnitFailure #
Instances
Exception HUnitFailure | |
Defined in Test.HUnit.Lang | |
Show HUnitFailure | |
Defined in Test.HUnit.Lang showsPrec :: Int -> HUnitFailure -> ShowS # show :: HUnitFailure -> String # showList :: [HUnitFailure] -> ShowS # | |
Eq HUnitFailure | |
Defined in Test.HUnit.Lang (==) :: HUnitFailure -> HUnitFailure -> Bool # (/=) :: HUnitFailure -> HUnitFailure -> Bool # |
Tests (for internal use)
hunitWrapperTests :: [(String, IO ())] Source #