]> code.delx.au - offlineimap/blobdiff - testsrc/runtests.hs
Tests enhanced
[offlineimap] / testsrc / runtests.hs
index 7eb124aec2564d6cceb022a66e3e335d38f212ce..079e48256074b7c2a0be5fb5e9e8d6b35149fbb3 100644 (file)
@@ -22,11 +22,13 @@ import Test.QuickCheck.Batch
 import qualified Test.HUnit as HU
 import Test.HUnit.Utils
 import qualified Data.Map as Map
+import System.IO
+import Text.Printf
 
 import Data.Syncable
 
 prop_empty =
-    syncThem emptymap emptymap emptymap == ([], [], [])
+    syncThem emptymap emptymap emptymap == ([], [], []) -- ([DeleteItem 5], [], [])
 
 keysToMap :: Ord k => [k] -> Map.Map k ()
 keysToMap = foldl (\map k -> Map.insert k () map) Map.empty
@@ -34,10 +36,32 @@ keysToMap = foldl (\map k -> Map.insert k () map) Map.empty
 emptymap :: Map.Map Integer ()
 emptymap = Map.empty
 
-allt = [qctest "Empty" prop_empty]
+allt = [("Empty", prop_empty)]
+alltHU = map (\(str, prop) -> qctest str prop) allt
+
+testh = HU.runTestTT $ HU.TestList alltHU
+testv = runVerbTestText (HU.putTextToHandle stderr True) $ HU.TestList alltHU
+
+testq = runTests "Test Stuff" defOpt (map (run . snd) allt)
+
+-- Modified from HUnit
+runVerbTestText :: HU.PutText st -> HU.Test -> IO (HU.Counts, st)
+runVerbTestText (HU.PutText put us) t = do
+  (counts, us') <- HU.performTest reportStart reportError reportFailure us t
+  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))
+                         put (HU.showCounts (HU.counts ss)) False us
+  reportError   = reportProblem "Error:"   "Error in:   "
+  reportFailure = reportProblem "Failure:" "Failure in: "
+  reportProblem p0 p1 msg ss us = put line True us
+   where line  = "### " ++ kind ++ path' ++ '\n' : msg
+         kind  = if null path' then p0 else p1
+         path' = HU.showPath (HU.path ss)
 
-testh = HU.runTestTT $ HU.TestList allt
          
 main = 
-    do testh
+    do testv
        return ()
+