]> code.delx.au - offlineimap/blobdiff - testsrc/runtests.hs
Added quoted test
[offlineimap] / testsrc / runtests.hs
index ba3eedf9089e7e9170e02df572bbff3bb9b9e722..c0f27bb0951b2155b554040b3e27d4fda09f86b3 100644 (file)
@@ -21,71 +21,32 @@ import Test.QuickCheck
 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.List
+import System.IO(stderr)
+import Data.Word
 
-import Data.Syncable
+import TestInfrastructure
 
-prop_empty :: Bool
-prop_empty =
-    syncThem emptymap emptymap emptymap == ([], [], []) -- ([DeleteItem 5], [], [])
+import qualified TestSyncable
+import qualified TestConnection
+import qualified TestParser
+import qualified TestParserPrim
 
-prop_delAllFromChild :: SyncCollection Int -> Bool
-prop_delAllFromChild inp =
-    let (resMaster, resChild, resState) = syncThem emptymap inp inp
-        expectedResChild = sort . map DeleteItem . Map.keys $ inp
-        in resMaster == [] &&
-           (sort resChild == expectedResChild) &&
-           (sort resState == expectedResChild)
+q :: Testable a => String -> a -> HU.Test
+q = qccheck (defaultConfig {configMaxTest = 250})
 
-prop_addFromMaster :: SyncCollection Int -> Bool
-prop_addFromMaster inp =
-    let (resMaster, resChild, resState) = syncThem inp emptymap emptymap
-        expectedResChild = sort . map CopyItem . Map.keys $ inp
-        in (resMaster == []) &&
-           (sort resChild == expectedResChild) &&
-           (sort resState == expectedResChild)
+tl msg t = HU.TestLabel msg $ HU.TestList t
 
-keysToMap :: Ord k => [k] -> Map.Map k ()
-keysToMap = foldl (\map k -> Map.insert k () map) Map.empty
+allt = [tl "TestSyncable" TestSyncable.allt,
+        tl "TestConnection" TestConnection.allt,
+        tl "TestParserPrim" TestParserPrim.allt,
+        tl "TestParser" TestParser.allt
+       ]
 
-emptymap :: Map.Map Int ()
-emptymap = Map.empty
+testh = HU.runTestTT $ HU.TestList allt
+testv = runVerbTestText (HU.putTextToHandle stderr True) $ HU.TestList allt
 
-allt = [("Empty", prop_empty),
-        ("Del all from child", prop_delAllFromChild)]
-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)
-
-instance (Arbitrary k, Eq k, Ord k) => Arbitrary (Map.Map k ()) where
-    arbitrary = 
-        do items <- arbitrary
-           return $ keysToMap items
-    coarbitrary = coarbitrary . Map.keys
-
--- 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)
-
-         
+        
 main = 
     do testv
        return ()