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 (pairToFunc ModifyContent) 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         masterChanges = map (pairToFunc ModifyContent) . catMaybes .
  74                         map checkIt . Map.toList . Map.intersection child
  75                             $ master
  76             where checkIt (k, v) =
  77                       case Map.lookup k master of
  78                         Nothing -> Nothing
  79                         Just v' -> if v /= v'
  80                                    then Just (k, v)
  81                                    else Nothing
  82         in (sort masterChanges, expectedResChild) @=?
  83            (sort resMaster, sort resChild)
  84
  85 prop_allChangesToMaster :: SyncCollection Int Float -> SyncCollection Int Float -> Result
  86 prop_allChangesToMaster master child =
  87     let (resMaster, resChild) = syncBiDir master child master
  88         expectedResMaster = sort $
  89             (map (pairToFunc CopyItem) . Map.toList . Map.difference child $ master) ++
  90             (map DeleteItem . Map.keys . Map.difference master $ child) ++
  91             (map (pairToFunc ModifyContent) changeList)
  92         changeList = foldl changefunc [] (Map.toList child)
  93         changefunc accum (k, v) =
  94             case Map.lookup k master of
  95               Nothing -> accum
  96               Just x -> if x /= v
  97                         then (k, v) : accum
  98                         else accum
  99         in (expectedResMaster, []) @=?
 100            (sort resMaster, resChild)
 101
 102 -- FIXME: test findModified
 103
 104 prop_allChanges :: SyncCollection Int Float -> SyncCollection Int Float -> SyncCollection Int Float -> Result
 105 prop_allChanges master child lastchild =
 106     let (resMaster, resChild) = syncBiDir master child lastchild
 107         masterChildCommon =
 108             Map.fromList . catMaybes . map procKV . Map.toList . Map.union
 109                 (Map.intersection master lastchild) $
 110                 (Map.intersection child master)
 111             where procKV (k, v) =
 112                       case (Map.lookup k master, Map.lookup k child,
 113                             Map.lookup k lastchild) of
 114                         (Just m, Just c, Just lc) ->
 115                             if lc == c
 116                                then if lc == m
 117                                     then Nothing
 118                                     else Just (k, m)
 119                                else Just (k, c)
 120                         (Just m, Just c, Nothing) ->
 121                             if m == c
 122                                then Nothing
 123                                else Just (k, c)
 124                         (Just m, Nothing, Just lc) ->
 125                             if m == lc
 126                                then Nothing
 127                                else Just (k, m)
 128                         (Nothing, Just c, Just lc) ->
 129                             if c == lc
 130                                then Nothing
 131                                else Just (k, c)
 132                         _ -> Nothing
 133
 134         masterMods = findNewMods masterChildCommon master
 135         childMods = findNewMods masterChildCommon child
 136
 137         findNewMods :: (Eq a, Ord a, Eq b) => SyncCollection a b -> SyncCollection a b -> [(a, b)]
 138         findNewMods common orig = catMaybes . map checkKV . Map.toList $ common
 139             where checkKV (k, v) =
 140                       case Map.lookup k orig of
 141                         Just v' -> if v' == v
 142                                    then Nothing
 143                                    else Just (k, v)
 144                         Nothing -> Nothing
 145
 146         expectedResMaster = sort $
 147             (map (pairToFunc CopyItem) . Map.toList . Map.difference child $ Map.union master lastchild) ++
 148                                                                                             (map DeleteItem . Map.keys . Map.intersection master $ Map.difference lastchild child) ++
 149             (map (pairToFunc ModifyContent) masterMods)
 150
 151         expectedResChild = sort $
 152             (map (pairToFunc CopyItem) . Map.toList . Map.difference master $ Map.union child lastchild) ++
 153                                                                                             (map DeleteItem . Map.keys . Map.intersection child $ Map.difference lastchild master) ++
 154             (map (pairToFunc ModifyContent) childMods)
 155
 156     in (expectedResMaster, expectedResChild) @=?
 157        (sort resMaster, sort resChild)
 158
 159 {- | Basic validation that unaryApplyChanges works -}
 160 prop_unaryApplyChanges :: SyncCollection Int Float -> [(Bool, Int, Float)] -> Result
 161 prop_unaryApplyChanges collection randcommands =
 162     let -- We use nubBy to make sure we don't get input that has reference
 163         -- to the same key more than once.  We then convert True/False to
 164         -- commands.
 165         commands = map toCommand . nubBy (\(x1, y1, z1) (x2, y2, z2) -> y1 == y2) $ randcommands
 166         toCommand (True, x, v) = CopyItem x v
 167         toCommand (False, x, _) = DeleteItem x
 168
 169         addedItems = catMaybes . map (\x -> case x of CopyItem y v -> Just (y, v); _ -> Nothing) $ commands
 170         deletedKeys = catMaybes . map (\x -> case x of DeleteItem y -> Just y; _ -> Nothing) $ commands
 171
 172         collection' = foldl (flip Map.delete) collection deletedKeys
 173         expectedCollection =
 174             Map.union collection' (Map.fromList addedItems)
 175         in (sort . Map.keys $ expectedCollection) @=?
 176            (sort . Map.keys $ unaryApplyChanges collection commands)
 177
 178 {- | Should validate both that unaryApplyChanges works, and that it is
 179 an identify -}
 180 prop_unaryApplyChangesId :: SyncCollection Int Float -> SyncCollection Int Float -> Result
 181 prop_unaryApplyChangesId master child =
 182     let (resMaster, resChild) = syncBiDir master child child
 183         newMaster = unaryApplyChanges master resMaster
 184         newChild = unaryApplyChanges child resChild
 185         newMasterKeys = sort . Map.keys $ newMaster
 186         newChildKeys = sort . Map.keys $ newChild
 187         in (True, sort (Map.keys master), sort (Map.keys master)) @=?
 188            (newMasterKeys == newChildKeys, newMasterKeys, newChildKeys)
 189
 190 prop_unaryApplyChanges3 :: SyncCollection Int Float -> SyncCollection Int Float -> SyncCollection Int Float -> Result
 191 prop_unaryApplyChanges3 master child lastChild =
 192     let (resMaster, resChild) = syncBiDir master child lastChild
 193         newMaster = unaryApplyChanges master resMaster
 194         newChild = unaryApplyChanges child resChild
 195     in newMaster @=? newChild
 196
 197 prop_diffCollection :: SyncCollection Int Float -> SyncCollection Int Float -> Result
 198 prop_diffCollection coll1 coll2 =
 199     let commands = diffCollection coll1 coll2
 200         newcoll2 = unaryApplyChanges coll1 commands
 201         in coll2 @=? newcoll2
 202
 203 allt = [qctest "Empty" prop_empty,
 204         qctest "Del all from child" prop_delAllFromChild,
 205         qctest "Del all from master" prop_delAllFromMaster,
 206         qctest "Add from master" prop_addFromMaster,
 207         qctest "All changes to child" prop_allChangesToChild,
 208         qctest "All changes to master" prop_allChangesToMaster,
 209         qctest "All changes" prop_allChanges,
 210         qctest "unaryApplyChanges" prop_unaryApplyChanges,
 211         qctest "unaryApplyChangesId" prop_unaryApplyChangesId,
 212         qctest "unaryApplyChanges3" prop_unaryApplyChanges3,
 213         qctest "diffCollection" prop_diffCollection
 214        ]
 215
 216 testh = HU.runTestTT $ HU.TestList allt
 217 testv = runVerbTestText (HU.putTextToHandle stderr True) $ HU.TestList allt
 218
 219
 220 main =
 221     do testv
 222        return ()
 223