reflect success/failure in doctest and unittest runners' exit codes

This commit is contained in:
Simon Michael 2009-06-05 17:29:20 +00:00
parent 5e08ad821e
commit 72ad595542
2 changed files with 9 additions and 3 deletions

View File

@ -202,6 +202,7 @@ import Data.Time.Format
import Locale (defaultTimeLocale) import Locale (defaultTimeLocale)
import Text.ParserCombinators.Parsec import Text.ParserCombinators.Parsec
import Test.HUnit.Tools (runVerboseTests) import Test.HUnit.Tools (runVerboseTests)
import System.Exit (exitFailure,exitSuccess)
import Commands.All import Commands.All
import Ledger import Ledger
@ -209,7 +210,11 @@ import Options
import Utils import Utils
runtests opts args = runner ts runtests opts args = do
(counts,_) <- runner ts
if errors counts > 0 || (failures counts > 0)
then exitFailure
else exitSuccess
where where
runner | (Verbose `elem` opts) = runVerboseTests runner | (Verbose `elem` opts) = runVerboseTests
| otherwise = \t -> runTestTT t >>= return . (flip (,) 0) | otherwise = \t -> runTestTT t >>= return . (flip (,) 0)

View File

@ -30,7 +30,7 @@ to that, and/or add this to hledger's built-in test runner.
module Main where module Main where
import Data.List (isPrefixOf) import Data.List (isPrefixOf)
import System (getArgs) import System (getArgs)
import System.Exit (ExitCode(ExitSuccess)) import System.Exit (ExitCode(ExitSuccess),exitFailure,exitSuccess)
import System.IO (hGetContents, hPutStr, hPutStrLn, stderr) import System.IO (hGetContents, hPutStr, hPutStrLn, stderr)
import System.Process (runInteractiveCommand, waitForProcess) import System.Process (runInteractiveCommand, waitForProcess)
import Text.Printf (printf) import Text.Printf (printf)
@ -40,7 +40,8 @@ main = do
s <- readFile f s <- readFile f
let tests = doctests s let tests = doctests s
putStrLn $ printf "Running %d doctests from %s" (length tests) f putStrLn $ printf "Running %d doctests from %s" (length tests) f
mapM_ runShellDocTest $ doctests s ok <- mapM runShellDocTest $ doctests s
if any not ok then exitFailure else exitSuccess
runShellDocTest :: String -> IO Bool runShellDocTest :: String -> IO Bool
runShellDocTest s = do runShellDocTest s = do