[commit: packages/filepath] master: If there is an error, show the messages again at the end, so you don't have to scroll back (7c628b3)
git at git.haskell.org
git at git.haskell.org
Thu Mar 19 11:37:26 UTC 2015
Repository : ssh://git@git.haskell.org/filepath
On branch : master
Link : http://git.haskell.org/packages/filepath.git/commitdiff/7c628b352dd7367a6f8850ccd1bf2cfd7fad9235
>---------------------------------------------------------------
commit 7c628b352dd7367a6f8850ccd1bf2cfd7fad9235
Author: Neil Mitchell <ndmitchell at gmail.com>
Date: Mon Nov 10 11:05:56 2014 +0000
If there is an error, show the messages again at the end, so you don't have to scroll back
>---------------------------------------------------------------
7c628b352dd7367a6f8850ccd1bf2cfd7fad9235
tests/Test.hs | 17 ++++++++++-------
1 file changed, 10 insertions(+), 7 deletions(-)
diff --git a/tests/Test.hs b/tests/Test.hs
index e3e0103..a7d82df 100755
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -4,6 +4,7 @@ module Test(main) where
import System.Environment
import TestGen
import Control.Monad
+import Data.Maybe
import Test.QuickCheck
@@ -13,14 +14,16 @@ main = do
let count = case args of i:_ -> read i; _ -> 10000
putStrLn $ "Testing with " ++ show count ++ " repetitions"
let total = length tests
- bs <- forM (zip [1..] tests) $ \(i,(msg,prop)) -> do
+ bad <- fmap catMaybes $ forM (zip [1..] tests) $ \(i,(msg,prop)) -> do
putStrLn $ "Test " ++ show i ++ " of " ++ show total ++ ": " ++ msg
res <- quickCheckWithResult stdArgs{chatty=False, maxSuccess=count} prop
case res of
- Success{} -> return True
- _ -> putStrLn "TEST FAILURE!" >> return False
- let bad = length $ filter (== False) bs
- if bad == 0 then
+ Success{} -> return Nothing
+ bad -> do print bad; putStrLn "TEST FAILURE!"; return $ Just (msg,bad)
+ if null bad then
putStrLn $ "Success, " ++ show total ++ " tests passed"
- else
- fail $ "FAILURE, failed " ++ show bad ++ " of " ++ show total ++ " tests (look for FAILURE)"
+ else do
+ putStrLn $ show (length bad) ++ " FAILURES\n"
+ forM_ (zip [1..] bad) $ \(i,(a,b)) ->
+ putStrLn $ "FAILURE " ++ show i ++ ": " ++ a ++ "\n" ++ show b ++ "\n"
+ fail $ "FAILURE, failed " ++ show (length bad) ++ " of " ++ show total ++ " tests"
More information about the ghc-commits
mailing list