[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