code.delx.au - offlineimap/blob - testsrc/runtests.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 Main where
  20 import Test.QuickCheck
  21 import Test.QuickCheck.Batch
  22 import qualified Test.HUnit as HU
  23 import Test.HUnit.Utils
  24 import qualified Data.Map as Map
  25 import Data.List
  26 import Data.Maybe(catMaybes)
  27 import System.IO(stderr)
  28
  29 import Data.Syncable
  30 import TestInfrastructure
  31
  32 prop_empty :: Bool
  33 prop_empty =
  34     syncBiDir (emptymap::Map.Map Int ()) emptymap emptymap == ([], []) -- ([DeleteItem 5], [], [])
  35
  36 prop_delAllFromChild :: SyncCollection Int () -> Result
  37 prop_delAllFromChild inp =
  38     let (resMaster, resChild) = syncBiDir emptymap inp inp
  39         expectedResChild = sort . map DeleteItem . Map.keys $ inp
  40         in ([], expectedResChild) @=?
  41            (resMaster, sort resChild)
  42
  43 prop_delAllFromMaster :: SyncCollection Int () -> Result
  44 prop_delAllFromMaster inp =
  45     let (resMaster, resChild) = syncBiDir inp emptymap inp
  46         expectedResMaster = sort . map DeleteItem . Map.keys $ inp
  47         in (expectedResMaster, []) @=?
  48            (sort resMaster, resChild)
  49
  50 prop_addFromMaster :: SyncCollection Int Float -> Result
  51 prop_addFromMaster inp =
  52     let (resMaster, resChild) = syncBiDir inp emptymap emptymap
  53         expectedResChild = sort . map (\(k, v) -> CopyItem k v) . Map.toList $ inp
  54         in ([], expectedResChild) @=?
  55            (resMaster, sort resChild)
  56
  57 -- FIXME: prop_addFromChild
  58
  59 prop_allChangesToChild :: SyncCollection Int Float -> SyncCollection Int Float -> Result
  60 prop_allChangesToChild master child =
  61     let (resMaster, resChild) = syncBiDir master child child
  62         expectedResChild = sort $
  63             (map (\(k, v) -> CopyItem k v) . Map.toList . Map.difference master $ child) ++
  64             (map DeleteItem . Map.keys . Map.difference child $ master) ++
  65             (map (\(k, v) -> ModifyContent k v) changeList)
  66         changeList = foldl changefunc [] (Map.toList child)
  67         changefunc accum (k, v) =
  68             case Map.lookup k master of
  69               Nothing -> accum
  70               Just x -> if x /= v
  71                         then (k, x) : accum
  72                         else accum
  73         in ([], expectedResChild) @=?
  74            (resMaster, sort resChild)
  75
  76 prop_allChangesToMaster :: SyncCollection Int Float -> SyncCollection Int Float -> Result
  77 prop_allChangesToMaster master child =
  78     let (resMaster, resChild) = syncBiDir master child master
  79         expectedResMaster = sort $
  80             (map (\(k, v) -> CopyItem k v) . Map.toList . Map.difference child $ master) ++
  81             (map DeleteItem . Map.keys . Map.difference master $ child) ++
  82             (map (\(k, v) -> ModifyContent k v) changeList)
  83         changeList = foldl changefunc [] (Map.toList child)
  84         changefunc accum (k, v) =
  85             case Map.lookup k master of
  86               Nothing -> accum
  87               Just x -> if x /= v
  88                         then (k, v) : accum
  89                         else accum
  90         in (expectedResMaster, []) @=?
  91            (sort resMaster, resChild)
  92
  93 prop_allChanges :: SyncCollection Int Float -> SyncCollection Int Float -> SyncCollection Int Float -> Result
  94 prop_allChanges master child lastchild =
  95     let (resMaster, resChild) = syncBiDir master child lastchild
  96         expectedResMaster = sort $
  97             (map (\(k, v) -> CopyItem k v) . Map.toList . Map.difference child $ Map.union master lastchild) ++
  98                                                                                             (map DeleteItem . Map.keys . Map.intersection master $ Map.difference lastchild child) ++
  99             (map (\(k, v) -> ModifyContent k v) masterChanges)
 100
 101         expectedResChild = sort $
 102             (map (\(k, v) -> CopyItem k v) . Map.toList . Map.difference master $ Map.union child lastchild) ++
 103                                                                                             (map DeleteItem . Map.keys . Map.intersection child $ Map.difference lastchild master) ++
 104             (map (\(k, v) -> ModifyContent k v) childChanges)
 105
 106         childChanges = foldl (changefunc True) [] (Map.toList child)
 107         masterChanges = foldl (changefunc False) [] (Map.toList child)
 108         changefunc useMaster accum (k, v) =
 109             case Map.lookup k master of
 110               Nothing -> accum
 111               Just x -> if x /= v
 112                         then if useMaster
 113                              then (k, x) : accum
 114                              else (k, v) : accum
 115                         else accum
 116     in (expectedResMaster, expectedResChild) @=?
 117        (sort resMaster, sort resChild)
 118
 119 {- | Basic validation that unaryApplyChanges works -}
 120 prop_unaryApplyChanges :: SyncCollection Int Float -> [(Bool, Int, Float)] -> Result
 121 prop_unaryApplyChanges collection randcommands =
 122     let -- We use nubBy to make sure we don't get input that has reference
 123         -- to the same key more than once.  We then convert True/False to
 124         -- commands.
 125         commands = map toCommand . nubBy (\(x1, y1, z1) (x2, y2, z2) -> y1 == y2) $ randcommands
 126         toCommand (True, x, v) = CopyItem x v
 127         toCommand (False, x, _) = DeleteItem x
 128
 129         addedItems = catMaybes . map (\x -> case x of CopyItem y v -> Just (y, v); _ -> Nothing) $ commands
 130         deletedKeys = catMaybes . map (\x -> case x of DeleteItem y -> Just y; _ -> Nothing) $ commands
 131
 132         collection' = foldl (flip Map.delete) collection deletedKeys
 133         expectedCollection =
 134             Map.union collection' (Map.fromList addedItems)
 135         in (sort . Map.keys $ expectedCollection) @=?
 136            (sort . Map.keys $ unaryApplyChanges collection commands)
 137
 138 {- | Should validate both that unaryApplyChanges works, and that it is
 139 an identify -}
 140 prop_unaryApplyChangesId :: SyncCollection Int Float -> SyncCollection Int Float -> Result
 141 prop_unaryApplyChangesId master child =
 142     let (resMaster, resChild) = syncBiDir master child child
 143         newMaster = unaryApplyChanges master resMaster
 144         newChild = unaryApplyChanges child resChild
 145         newMasterKeys = sort . Map.keys $ newMaster
 146         newChildKeys = sort . Map.keys $ newChild
 147         in (True, sort (Map.keys master), sort (Map.keys master)) @=?
 148            (newMasterKeys == newChildKeys, newMasterKeys, newChildKeys)
 149
 150 prop_unaryApplyChanges3 :: SyncCollection Int Float -> SyncCollection Int Float -> SyncCollection Int Float -> Result
 151 prop_unaryApplyChanges3 master child lastChild =
 152     let (resMaster, resChild) = syncBiDir master child lastChild
 153         newMaster = unaryApplyChanges master resMaster
 154         newChild = unaryApplyChanges child resChild
 155     in newMaster @=? newChild
 156
 157 prop_diffCollection :: SyncCollection Int Float -> SyncCollection Int Float -> Result
 158 prop_diffCollection coll1 coll2 =
 159     let commands = diffCollection coll1 coll2
 160         newcoll2 = unaryApplyChanges coll1 commands
 161         in coll2 @=? newcoll2
 162
 163 allt = [qctest "Empty" prop_empty,
 164         qctest "Del all from child" prop_delAllFromChild,
 165         qctest "Del all from master" prop_delAllFromMaster,
 166         qctest "Add from master" prop_addFromMaster,
 167         qctest "All changes to child" prop_allChangesToChild,
 168         qctest "All changes to master" prop_allChangesToMaster,
 169         qctest "All changes" prop_allChanges,
 170         qctest "unaryApplyChanges" prop_unaryApplyChanges,
 171         qctest "unaryApplyChangesId" prop_unaryApplyChangesId,
 172         qctest "unaryApplyChanges3" prop_unaryApplyChanges3,
 173         qctest "diffCollection" prop_diffCollection
 174        ]
 175
 176 testh = HU.runTestTT $ HU.TestList allt
 177 testv = runVerbTestText (HU.putTextToHandle stderr True) $ HU.TestList allt
 178
 179
 180 main =
 181     do testv
 182        return ()
 183