Added verbose test support

diff --git a/testsrc/TestInfrastructure.hs b/testsrc/TestInfrastructure.hs
index ec22ba7e963bafa50552d59e489284c977992585..96db4ad4ea4d44750f377ef7531a1c530b5bdc89 100644 (file)
--- 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 ff016fb2d9467dca515d594c79d7976f1ff64d2b..29cbfc94a999fa5f4f25a26d3b6238d7a60808ad 100644 (file)
--- 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