runTestsOrExit

hledger/Hledger/Cli/Tests.hs

@@ -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
+runtests opts args = do
-  (counts,_) <- liftM (flip (,) 0) $ runTestTT ts
+  (hunitcounts,_) <- runtests' opts args
-  if errors counts > 0 || (failures counts > 0)
+  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
-