From 33b19c27f63442c8b5705aac5f8862831fba70ad Mon Sep 17 00:00:00 2001
From: John Goerzen <jgoerzen@complete.org>
Date: Tue, 12 Aug 2008 02:52:09 -0500
Subject: [PATCH] Added verbose test support

---
 testsrc/TestInfrastructure.hs | 7 ++++++-
 testsrc/TestParserPrim.hs     | 5 +++++
 2 files changed, 11 insertions(+), 1 deletion(-)

diff --git a/testsrc/TestInfrastructure.hs b/testsrc/TestInfrastructure.hs
index ec22ba7..96db4ad 100644
--- a/testsrc/TestInfrastructure.hs
+++ b/testsrc/TestInfrastructure.hs
@@ -82,13 +82,18 @@ runVerbTestText (HU.PutText put us) t = do
          path' = HU.showPath (HU.path ss)
 
 q :: Testable a => String -> a -> HU.Test
-q = qccheck (defaultConfig {configMaxTest = 250, configMaxFail = 10000,
+q = qccheck (defaultConfig {configMaxTest = 250, configMaxFail = 20000,
                             configEvery = \_ _ -> ""})
     -- configEvery = testCount for displaying a running test counter
     where testCountBase n = " (test " ++ show n ++ "/250)"
           testCount n _ = testCountBase n ++ 
                           replicate (length (testCountBase n)) '\b'
 
+qverbose :: Testable a => String -> a -> HU.Test
+qverbose = qccheck (defaultConfig {configMaxTest = 250, configMaxFail = 20000,
+                            configEvery = \n args -> show n ++ ":\n" ++ unlines args})
+
+
 {- | Test a parser, forcing it to apply to all input. -}
 p parser input = 
     case parse parseTest "(none)" input of
diff --git a/testsrc/TestParserPrim.hs b/testsrc/TestParserPrim.hs
index ff016fb..29cbfc9 100644
--- a/testsrc/TestParserPrim.hs
+++ b/testsrc/TestParserPrim.hs
@@ -68,6 +68,10 @@ prop_astring_basic s =
                        then Just s
                        else Nothing
 
+prop_astring_basic_thorough :: String -> Property
+prop_astring_basic_thorough s =
+    isValidAtom s ==> p astring s @?= Just s
+
 isValidAtom s = not (null s) && all isValidChar s
     where isValidChar c =
               c `notElem` atomSpecials ||
@@ -102,6 +106,7 @@ allt = [q "quoted" prop_quoted,
         q "string3501" prop_string3501,
         q "atom" prop_atom,
         q "astring basic" prop_astring_basic,
+        qverbose "astring basic thorough" prop_astring_basic_thorough,
         q "astring full" prop_astring,
         q "text" prop_text,
         q "tag" prop_tag
-- 
2.39.2