aboutsummaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authorJason Creighton <jcreigh@gmail.com>2007-05-05 19:43:57 +0200
committerJason Creighton <jcreigh@gmail.com>2007-05-05 19:43:57 +0200
commit23a3031e391b4f5394cce656777bed2859fdecc0 (patch)
tree5a4f637617baeb13eb87cf4f27fb36446880ce6d /tests
parent247bc61f68db6a8f858d410818c8ac0348a59294 (diff)
downloadxmonad-23a3031e391b4f5394cce656777bed2859fdecc0.tar.gz
xmonad-23a3031e391b4f5394cce656777bed2859fdecc0.tar.xz
xmonad-23a3031e391b4f5394cce656777bed2859fdecc0.zip
make Properties.hs exit with failure on test failure
darcs-hash:20070505174357-b9aa7-2dc94a5ade7740c859831865d49e2da28d2ba0ac.gz
Diffstat (limited to 'tests')
-rw-r--r--tests/Properties.hs15
1 files changed, 8 insertions, 7 deletions
diff --git a/tests/Properties.hs b/tests/Properties.hs
index d630d0c..b4e90a6 100644
--- a/tests/Properties.hs
+++ b/tests/Properties.hs
@@ -304,7 +304,8 @@ main :: IO ()
main = do
args <- getArgs
let n = if null args then 100 else read (head args)
- mapM_ (\(s,a) -> printf "%-25s: " s >> a n) tests
+ results <- mapM (\(s,a) -> printf "%-25s: " s >> a n) tests
+ when (not . and $ results) $ fail "Not all tests passed!"
where
n = 100
@@ -364,20 +365,20 @@ main = do
debug = False
-mytest :: Testable a => a -> Int -> IO ()
+mytest :: Testable a => a -> Int -> IO Bool
mytest a n = mycheck defaultConfig
{ configMaxTest=n
, configEvery= \n args -> if debug then show n ++ ":\n" ++ unlines args else [] } a
-mycheck :: Testable a => Config -> a -> IO ()
+mycheck :: Testable a => Config -> a -> IO Bool
mycheck config a = do
rnd <- newStdGen
mytests config (evaluate a) rnd 0 0 []
-mytests :: Config -> Gen Result -> StdGen -> Int -> Int -> [[String]] -> IO ()
+mytests :: Config -> Gen Result -> StdGen -> Int -> Int -> [[String]] -> IO Bool
mytests config gen rnd0 ntest nfail stamps
- | ntest == configMaxTest config = do done "OK," ntest stamps
- | nfail == configMaxFail config = do done "Arguments exhausted after" ntest stamps
+ | ntest == configMaxTest config = done "OK," ntest stamps >> return True
+ | nfail == configMaxFail config = done "Arguments exhausted after" ntest stamps >> return True
| otherwise =
do putStr (configEvery config ntest (arguments result)) >> hFlush stdout
case ok result of
@@ -390,7 +391,7 @@ mytests config gen rnd0 ntest nfail stamps
++ show ntest
++ " tests:\n"
++ unlines (arguments result)
- ) >> hFlush stdout
+ ) >> hFlush stdout >> return False
where
result = generate (configSize config ntest) rnd2 gen
(rnd1,rnd2) = split rnd0