]> code.delx.au - offlineimap/blobdiff - testsrc/TestInfrastructure.hs
Suppress the test counter
[offlineimap] / testsrc / TestInfrastructure.hs
index 83b0b84a9b4fdb8e3e41e575fecc242d187e7f1b..255a2328bef2e092dd76fa4f2d046ad1ef79b923 100644 (file)
@@ -24,6 +24,8 @@ import qualified Data.Map as Map
 import System.IO
 import Text.Printf
 import System.Random
+import Data.Word
+import Test.HUnit.Utils
 
 (@=?) :: (Eq a, Show a) => a -> a -> Result
 expected @=? actual = 
@@ -56,6 +58,11 @@ instance Random Word8 where
                        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) maxBound)
+    coarbitrary n = variant (if (fromEnum n) >= 0 then toEnum (2 * x) else 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
@@ -63,7 +70,7 @@ 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 %-68s\n" (HU.showPath (HU.path ss))
                          put (HU.showCounts (HU.counts ss)) False us
   reportError   = reportProblem "Error:"   "Error in:   "
   reportFailure = reportProblem "Failure:" "Failure in: "
@@ -72,3 +79,11 @@ 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 = 10000,
+                            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'
+