Restrict character generation to first 255

[offlineimap] / testsrc / TestInfrastructure.hs

diff --git a/testsrc/TestInfrastructure.hs b/testsrc/TestInfrastructure.hs
index 45d0f0a18d43733855e04d6f9337c1ad5807a8cf..41419bdddb9150b09afb03fba3c6ebe2fdd8d16d 100644 (file)
--- a/testsrc/TestInfrastructure.hs
+++ b/testsrc/TestInfrastructure.hs
@@ -23,6 +23,10 @@ import qualified Test.HUnit as HU
 import qualified Data.Map as Map
 import System.IO
 import Text.Printf
+import System.Random
+import Data.Word
+import Test.HUnit.Utils
+import Text.ParserCombinators.Parsec
 
 (@=?) :: (Eq a, Show a) => a -> a -> Result
 expected @=? actual = 
@@ -45,6 +49,21 @@ instance (Arbitrary k, Arbitrary v, Eq k, Ord k) => Arbitrary (Map.Map k v) wher
            return $ Map.fromList items
     coarbitrary = coarbitrary . Map.keys
 
+instance Arbitrary Word8 where
+    arbitrary = sized $ \n -> choose (0, min (fromIntegral n) maxBound)
+    coarbitrary n = variant (if n >= 0 then 2 * x else 2 * x + 1)
+                where x = abs . fromIntegral $ n
+
+instance Random Word8 where
+    randomR (a, b) g = (\(x, y) -> (fromInteger x, y)) $
+                       randomR (toInteger a, toInteger b) g
+    random g = randomR (minBound, maxBound) g
+
+instance Arbitrary Char where
+    arbitrary = sized $ \n -> choose (toEnum 0, min (toEnum (n * 0x50)) '\xFF')
+    coarbitrary n = variant (toEnum (2 * x + 1))
+                where x = (abs . fromEnum $ n)::Int
+
 -- Modified from HUnit
 runVerbTestText :: HU.PutText st -> HU.Test -> IO (HU.Counts, st)
 runVerbTestText (HU.PutText put us) t = do
@@ -52,7 +71,8 @@ runVerbTestText (HU.PutText put us) t = do
   us'' <- put (HU.showCounts counts) True us'
   return (counts, us'')
  where
-  reportStart ss us = do hPrintf stderr "\rTesting %-68s\n" (HU.showPath (HU.path ss))
+  reportStart ss us = do hPrintf stdout "\rTesting %-70s\n"
+                                     (HU.showPath (HU.path ss))
                          put (HU.showCounts (HU.counts ss)) False us
   reportError   = reportProblem "Error:"   "Error in:   "
   reportFailure = reportProblem "Failure:" "Failure in: "
@@ -61,3 +81,25 @@ runVerbTestText (HU.PutText put us) t = do
          kind  = if null path' then p0 else p1
          path' = HU.showPath (HU.path ss)
 
+q :: Testable a => String -> a -> HU.Test
+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
+      Left _ -> Nothing
+      Right y -> Just y
+    where parseTest = do r <- parser
+                         eof
+                         return r
+