runTestsOrExit

This commit is contained in:
Simon Michael 2011-06-13 21:44:08 +00:00
parent 774434fcf2
commit 7d46ae6141

View File

@ -37,15 +37,23 @@ import Hledger.Data
import Hledger.Utils
-- | Run unit tests.
-- | Run unit tests and exit with success or failure.
runtests :: [Opt] -> [String] -> IO ()
runtests _ args = do
(counts,_) <- liftM (flip (,) 0) $ runTestTT ts
if errors counts > 0 || (failures counts > 0)
runtests opts args = do
(hunitcounts,_) <- runtests' opts args
if errors hunitcounts > 0 || (failures hunitcounts > 0)
then exitFailure
else exitWith ExitSuccess
-- | Run unit tests and exit on failure.
runTestsOrExit :: [Opt] -> [String] -> IO ()
runTestsOrExit opts args = do
(hunitcounts,_) <- runtests' opts args
when (errors hunitcounts > 0 || (failures hunitcounts > 0)) $ exitFailure
runtests' :: Num b => t -> [String] -> IO (Counts, b)
runtests' _ args = liftM (flip (,) 0) $ runTestTT ts
where
ts = TestList $ filter matchname $ tflatten tests_Hledger_Cli -- show flat test names
-- ts = tfilter matchname $ TestList tests -- show hierarchical test names
matchname = matchpats args . tname