code.delx.au - offlineimap/blob - testsrc/TestInfrastructure.hs

   1 {-
   2 Copyright (C) 2002-2008 John Goerzen <jgoerzen@complete.org>
   3
   4 This program is free software; you can redistribute it and/or modify
   5 it under the terms of the GNU General Public License as published by
   6 the Free Software Foundation; either version 2 of the License, or
   7 (at your option) any later version.
   8
   9 This program is distributed in the hope that it will be useful,
  10 but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 GNU General Public License for more details.
  13
  14 You should have received a copy of the GNU General Public License
  15 along with this program; if not, write to the Free Software
  16 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  17 -}
  18
  19 module TestInfrastructure where
  20 import Test.QuickCheck
  21 import Test.QuickCheck.Batch
  22 import qualified Test.HUnit as HU
  23 import qualified Data.Map as Map
  24 import System.IO
  25 import Text.Printf
  26
  27 (@=?) :: (Eq a, Show a) => a -> a -> Result
  28 expected @=? actual =
  29         Result {ok = Just (expected == actual),
  30                 arguments = ["Result: expected " ++ show expected ++ ", got " ++ show actual],
  31                 stamp = []}
  32
  33 (@?=) :: (Eq a, Show a) => a -> a -> Result
  34 (@?=) = flip (@=?)
  35
  36 keysToMap :: Ord k => [k] -> Map.Map k ()
  37 keysToMap = foldl (\map k -> Map.insert k () map) Map.empty
  38
  39 emptymap :: (Eq k, Ord k, Show v) => Map.Map k v
  40 emptymap = Map.empty
  41
  42 instance (Arbitrary k, Arbitrary v, Eq k, Ord k) => Arbitrary (Map.Map k v) where
  43     arbitrary =
  44         do items <- arbitrary
  45            return $ Map.fromList items
  46     coarbitrary = coarbitrary . Map.keys
  47
  48 -- Modified from HUnit
  49 runVerbTestText :: HU.PutText st -> HU.Test -> IO (HU.Counts, st)
  50 runVerbTestText (HU.PutText put us) t = do
  51   (counts, us') <- HU.performTest reportStart reportError reportFailure us t
  52   us'' <- put (HU.showCounts counts) True us'
  53   return (counts, us'')
  54  where
  55   reportStart ss us = do hPrintf stderr "\rTesting %-68s\n" (HU.showPath (HU.path ss))
  56                          put (HU.showCounts (HU.counts ss)) False us
  57   reportError   = reportProblem "Error:"   "Error in:   "
  58   reportFailure = reportProblem "Failure:" "Failure in: "
  59   reportProblem p0 p1 msg ss us = put line True us
  60    where line  = "### " ++ kind ++ path' ++ '\n' : msg
  61          kind  = if null path' then p0 else p1
  62          path' = HU.showPath (HU.path ss)
  63