diff --git a/HUnit-Plus.cabal b/HUnit-Plus.cabal --- a/HUnit-Plus.cabal +++ b/HUnit-Plus.cabal @@ -1,6 +1,6 @@ Name: HUnit-Plus Category: Testing, Test -Version: 0.3.1 +Version: 0.3.2 License: BSD3 License-File: LICENSE Author: Eric McCorkle @@ -24,7 +24,7 @@ Lastly, HUnit-Plus provides a wrapper which generates standalone test-execution programs from a set of test suites. . - This is release candidate 2 for 1.0 (1.0-RC2) + This is the third release candidate for 1.0. Build-type: Simple Cabal-version: >= 1.16 diff --git a/src/Test/HUnitPlus/Base.hs b/src/Test/HUnitPlus/Base.hs --- a/src/Test/HUnitPlus/Base.hs +++ b/src/Test/HUnitPlus/Base.hs @@ -37,6 +37,7 @@ Test(..), TestInstance(..), TestSuite(..), + testSuite, -- ** Extended Test Creation Testable(..), @@ -46,7 +47,6 @@ (~:), (~?), - -- * Assertions Assertion, assertSuccess, @@ -57,6 +57,9 @@ assertString, assertStringWithPrefix, assertEqual, + assertThrows, + assertThrowsExact, + -- ** Extended Assertion Functionality Assertable(..), (@=?), @@ -158,8 +161,15 @@ return (Finished (Fail msg)) Nothing -> do - return (Finished (Error ("Uncaught exception in test: " ++ - show ex))) + TestInfo { tiIgnoreResult = ignoreRes } <- readIORef testinfo + if ignoreRes + then do + logError ("Uncaught exception in test: " ++ show ex) + return (Finished (Error ("Uncaught exception in test: " ++ + show ex))) + else do + return (Finished (Error ("Uncaught exception in test: " ++ + show ex))) caughtAction = catch action handleExceptions in do @@ -218,6 +228,7 @@ finalUs <- reportError msg ss eventsUs return $! (ss { stCounts = c { cAsserts = asserts + fromIntegral currAsserts, + cCaseAsserts = fromIntegral currAsserts, cErrors = errors + 1 } }, finalUs) Fail msg | not ignoreRes -> @@ -225,10 +236,12 @@ finalUs <- reportFailure msg ss eventsUs return $! (ss { stCounts = c { cAsserts = asserts + fromIntegral currAsserts, + cCaseAsserts = fromIntegral currAsserts, cFailures = failures + 1 } }, finalUs) _ -> return $! (ss { stCounts = c { cAsserts = asserts + fromIntegral currAsserts, + cCaseAsserts = fromIntegral currAsserts, cFailures = if hasFailure then failures + 1 @@ -369,6 +382,56 @@ in assertBool msg (actual == expected) +-- | Utility function for exception-checking assertions. +expectException :: Exception e + => (e -> Bool) + -- ^ Checks if an exception is valid. + -> (e -> String) + -- ^ Generates an error message. + -> e + -- ^ The exception. + -> Assertion +expectException testfunc msgfunc ex = + if testfunc ex + then assertSuccess + else assertFailure (msgfunc ex) + +-- | Assert that the given computation throws a specific exception. +assertThrowsExact :: (Exception e, Show e, Eq e) + => e + -- ^ Exception to be caught + -> IO a + -- ^ Computation that should throw the exception + -> Assertion +assertThrowsExact ex comp = + let + runComp = comp >> assertFailure ("expected exception " ++ show ex ++ + " but computation finished normally") + msgfunc ex' = "expected exception " ++ show ex ++ " but got " ++ show ex' + handler = expectException (ex ==) msgfunc + in + handle handler runComp + +-- | Assert that the given computation throws an exception that +-- matches a predicate. +assertThrows :: (Exception e, Show e) + => (e -> Bool) + -- ^ Exception to be caught + -> IO a + -- ^ Computation that should throw the exception + -> Assertion +assertThrows check comp = + let + runComp = + do + _ <- comp + assertFailure "expected exception but computation finished normally" + + msgfunc ex = "unexpected exception " ++ show ex + handler = expectException check msgfunc + in + handle handler runComp + -- Overloaded `assert` Function -- ---------------------------- @@ -476,21 +539,28 @@ suiteConcurrently :: !Bool, -- | A list of all options used by this suite, and the default -- values for those options. - suiteOptions :: [(String, String)], + suiteOptions :: ![(String, String)], -- | The tests in the suite. - suiteTests :: [Test] + suiteTests :: ![Test] } +-- | Create a test suite from a name and a list of tests. +testSuite :: String + -- ^ The suite's name. + -> [Test] + -- ^ The tests in the suite. + -> TestSuite +testSuite suitename testlist = + TestSuite { suiteName = suitename, suiteConcurrently = True, + suiteOptions = [], suiteTests = testlist } + -- Overloaded `test` Function -- -------------------------- {-# NOINLINE syntheticName #-} syntheticName :: String syntheticName = "__synthetic__" -{- -handleException :: SomeException -> IO () -handleException e = logError ("Exception occurred during test:\n" ++ show e) --} + wrapTest :: IO a -> IO Progress wrapTest t = do diff --git a/src/Test/HUnitPlus/Execution.hs b/src/Test/HUnitPlus/Execution.hs --- a/src/Test/HUnitPlus/Execution.hs +++ b/src/Test/HUnitPlus/Execution.hs @@ -38,7 +38,7 @@ reporterError = reportError, reporterEndCase = reportEndCase } ss @ State { stCounts = c @ Counts { cTried = tried, - cCases = cases }, + cCases = cases }, stName = oldname, stOptions = optmap, stOptionDescs = descs } initialUs initTi @ TestInstance { name = testname, @@ -223,8 +223,7 @@ endedUs <- reportEndSuite time finishedState finishedUs return $! (stCounts finishedState, endedUs) _ -> - return $! (Counts { cCases = 0, cTried = 0, cErrors = 0, cFailures = 0, - cAsserts = 0, cSkipped = 0 }, initialUs) + return $! (zeroCounts, initialUs) -- | Top-level function for a test run. Given a set of suites and a -- map from suite names to selectors, execute all suites that have @@ -243,9 +242,6 @@ reporterEnd = reportEnd } filters suites = let - initialCounts = Counts { cCases = 0, cTried = 0, cErrors = 0, - cFailures = 0, cAsserts = 0, cSkipped = 0 } - combineCounts Counts { cCases = cases1, cTried = tried1, cErrors = errors1, cFailures = failures1, cAsserts = asserts1, cSkipped = skipped1 } @@ -254,7 +250,8 @@ cAsserts = asserts2, cSkipped = skipped2 } = Counts { cCases = cases1 + cases2, cTried = tried1 + tried2, cErrors = errors1 + errors2, cFailures = failures1 + failures2, - cAsserts = asserts1 + asserts2, cSkipped = skipped1 + skipped2 } + cAsserts = asserts1 + asserts2, cSkipped = skipped1 + skipped2, + cCaseAsserts = 0 } foldfun (accumCounts, accumUs) suite = do @@ -263,6 +260,6 @@ in do initialUs <- reportStart (time, (finishedCounts, finishedUs)) <- - timeItT (foldM foldfun (initialCounts, initialUs) suites) + timeItT (foldM foldfun (zeroCounts, initialUs) suites) endedUs <- reportEnd time finishedCounts finishedUs return $! (finishedCounts, endedUs) diff --git a/src/Test/HUnitPlus/Reporting.hs b/src/Test/HUnitPlus/Reporting.hs --- a/src/Test/HUnitPlus/Reporting.hs +++ b/src/Test/HUnitPlus/Reporting.hs @@ -42,7 +42,9 @@ -- | Number of cases that were skipped. cSkipped :: !Word, -- | Total number of assertions checked. - cAsserts :: !Word + cAsserts :: !Word, + -- | Number of assertions checked by the last test case. + cCaseAsserts :: !Word } deriving (Eq, Show, Read) @@ -163,7 +165,7 @@ -- | A 'Counts' with all zero counts. zeroCounts :: Counts -zeroCounts = Counts { cCases = 0, cTried = 0, cErrors = 0, +zeroCounts = Counts { cCases = 0, cTried = 0, cErrors = 0, cCaseAsserts = 0, cFailures = 0, cAsserts = 0, cSkipped = 0 } -- | A reporter containing default actions, which are to do nothing diff --git a/src/Test/HUnitPlus/XML.hs b/src/Test/HUnitPlus/XML.hs --- a/src/Test/HUnitPlus/XML.hs +++ b/src/Test/HUnitPlus/XML.hs @@ -188,7 +188,7 @@ reportStartCase _ stack = return ([] : stack) reportEndCase time State { stName = name, stPath = testpath, - stCounts = Counts { cAsserts = asserts } } + stCounts = Counts { cCaseAsserts = asserts } } (events : rest : stack) = return ((testcaseElem name (showPath testpath) asserts time (reverse events) : rest) : stack)