From 7d46ae61419cf70fc42535fd48db44031df30f66 Mon Sep 17 00:00:00 2001
From: Simon Michael <simon@joyful.com>
Date: Mon, 13 Jun 2011 21:44:08 +0000
Subject: [PATCH] runTestsOrExit

---
 hledger/Hledger/Cli/Tests.hs | 18 +++++++++++++-----
 1 file changed, 13 insertions(+), 5 deletions(-)

diff --git a/hledger/Hledger/Cli/Tests.hs b/hledger/Hledger/Cli/Tests.hs
index 58664c8f2..96adbc028 100644
--- a/hledger/Hledger/Cli/Tests.hs
+++ b/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
-  (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
-