[commit: packages/filepath] master: When there is a failure, show the QuickCheck output in a better format (2d7ddec)

git at git.haskell.org git at git.haskell.org
Thu Mar 19 11:37:41 UTC 2015


Repository : ssh://git@git.haskell.org/filepath

On branch  : master
Link       : http://git.haskell.org/packages/filepath.git/commitdiff/2d7ddec7db144e8a3c3612b060603b15e97b9e18

>---------------------------------------------------------------

commit 2d7ddec7db144e8a3c3612b060603b15e97b9e18
Author: Neil Mitchell <ndmitchell at gmail.com>
Date:   Mon Nov 10 18:14:11 2014 +0000

    When there is a failure, show the QuickCheck output in a better format


>---------------------------------------------------------------

2d7ddec7db144e8a3c3612b060603b15e97b9e18
 tests/Test.hs | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/tests/Test.hs b/tests/Test.hs
index a7d82df..b9b695b 100755
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -14,16 +14,17 @@ main = do
     let count = case args of i:_ -> read i; _ -> 10000
     putStrLn $ "Testing with " ++ show count ++ " repetitions"
     let total = length tests
+    let showOutput x = show x{output=""} ++ "\n" ++ output x
     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 Nothing
-            bad -> do print bad; putStrLn "TEST FAILURE!"; return $ Just (msg,bad)
+            bad -> do putStrLn $ showOutput bad; putStrLn "TEST FAILURE!"; return $ Just (msg,bad)
     if null bad then
         putStrLn $ "Success, " ++ show total ++ " tests passed"
      else do
         putStrLn $ show (length bad) ++ " FAILURES\n"
         forM_ (zip [1..] bad) $ \(i,(a,b)) ->
-            putStrLn $ "FAILURE " ++ show i ++ ": " ++ a ++ "\n" ++ show b ++ "\n"
+            putStrLn $ "FAILURE " ++ show i ++ ": " ++ a ++ "\n" ++ showOutput b ++ "\n"
         fail $ "FAILURE, failed " ++ show (length bad) ++ " of " ++ show total ++ " tests"



More information about the ghc-commits mailing list