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
 108         masterMods = catMaybes . map procKV $ (Map.toList master)
 109             where procKV (k, m) =
 110                       case (Map.lookup k child, Map.lookup k lastchild) of
 111                         (Just c, Just lc) ->
 112                             if c == lc -- child didn't change
 113                                then Nothing
 114                                else if c == m -- child and master changed
 115                                     then Nothing
 116                                     else Just (k, c) -- child changed, master didn't
 117                         (Nothing, Just lc) -> Nothing -- deleted on child
 118                         (Just c, Nothing) -> -- New on both c and m
 119                             if c == m        -- Added the same
 120                                then Nothing
 121                                else Just (k, c) -- Added but differ
 122                         (Nothing, Nothing) -> Nothing -- New to master only
 123
 124         childMods = catMaybes . map procKV $ (Map.toList child)
 125             where procKV (k, c) =
 126                       case (Map.lookup k master, Map.lookup k lastchild) of
 127                         (Just m, Just lc) ->
 128                             if lc == c
 129                                then if c == m
 130                                        then Nothing
 131                                        else Just (k, m)
 132                                else Nothing
 133                         (Nothing, Just lc) ->        -- deleted; nothing to see here
 134                                               Nothing
 135                         (Just m, Nothing) -> -- New on both; child takes precedence
 136                            Nothing
 137                         (Nothing, Nothing) -> Nothing -- New to child only
 138
 139         expectedResMaster = sort $
 140             (map (pairToFunc CopyItem) . Map.toList . Map.difference child $ Map.union master lastchild) ++
 141                                                                                             (map DeleteItem . Map.keys . Map.intersection master $ Map.difference lastchild child) ++
 142             (map (pairToFunc ModifyContent) masterMods)
 143
 144         expectedResChild = sort $
 145             (map (pairToFunc CopyItem) . Map.toList . Map.difference master $ Map.union child lastchild) ++
 146                                                                                             (map DeleteItem . Map.keys . Map.intersection child $ Map.difference lastchild master) ++
 147             (map (pairToFunc ModifyContent) childMods)
 148
 149     in (expectedResMaster, expectedResChild) @=?
 150        (sort resMaster, sort resChild)
 151
 152 {- | Basic validation that unaryApplyChanges works -}
 153 prop_unaryApplyChanges :: SyncCollection Int Float -> [(Bool, Int, Float)] -> Result
 154 prop_unaryApplyChanges collection randcommands =
 155     let -- We use nubBy to make sure we don't get input that has reference
 156         -- to the same key more than once.  We then convert True/False to
 157         -- commands.
 158         commands = map toCommand . nubBy (\(x1, y1, z1) (x2, y2, z2) -> y1 == y2) $ randcommands
 159         toCommand (True, x, v) = CopyItem x v
 160         toCommand (False, x, _) = DeleteItem x
 161
 162         addedItems = catMaybes . map (\x -> case x of CopyItem y v -> Just (y, v); _ -> Nothing) $ commands
 163         deletedKeys = catMaybes . map (\x -> case x of DeleteItem y -> Just y; _ -> Nothing) $ commands
 164
 165         collection' = foldl (flip Map.delete) collection deletedKeys
 166         expectedCollection =
 167             Map.union collection' (Map.fromList addedItems)
 168         in (sort . Map.keys $ expectedCollection) @=?
 169            (sort . Map.keys $ unaryApplyChanges collection commands)
 170
 171 {- | Should validate both that unaryApplyChanges works, and that it is
 172 an identify -}
 173 prop_unaryApplyChangesId :: SyncCollection Int Float -> SyncCollection Int Float -> Result
 174 prop_unaryApplyChangesId master child =
 175     let (resMaster, resChild) = syncBiDir master child child
 176         newMaster = unaryApplyChanges master resMaster
 177         newChild = unaryApplyChanges child resChild
 178         newMasterKeys = sort . Map.keys $ newMaster
 179         newChildKeys = sort . Map.keys $ newChild
 180         in (True, sort (Map.keys master), sort (Map.keys master)) @=?
 181            (newMasterKeys == newChildKeys, newMasterKeys, newChildKeys)
 182
 183 prop_unaryApplyChanges3 :: SyncCollection Int Float -> SyncCollection Int Float -> SyncCollection Int Float -> Result
 184 prop_unaryApplyChanges3 master child lastChild =
 185     let (resMaster, resChild) = syncBiDir master child lastChild
 186         newMaster = unaryApplyChanges master resMaster
 187         newChild = unaryApplyChanges child resChild
 188     in newMaster @=? newChild
 189
 190 prop_diffCollection :: SyncCollection Int Float -> SyncCollection Int Float -> Result
 191 prop_diffCollection coll1 coll2 =
 192     let commands = diffCollection coll1 coll2
 193         newcoll2 = unaryApplyChanges coll1 commands
 194         in coll2 @=? newcoll2
 195
 196 allt = [qctest "Empty" prop_empty,
 197         qctest "Del all from child" prop_delAllFromChild,
 198         qctest "Del all from master" prop_delAllFromMaster,
 199         qctest "Add from master" prop_addFromMaster,
 200         qctest "All changes to child" prop_allChangesToChild,
 201         qctest "All changes to master" prop_allChangesToMaster,
 202         qctest "All changes" prop_allChanges,
 203         qctest "unaryApplyChanges" prop_unaryApplyChanges,
 204         qctest "unaryApplyChangesId" prop_unaryApplyChangesId,
 205         qctest "unaryApplyChanges3" prop_unaryApplyChanges3,
 206         qctest "diffCollection" prop_diffCollection
 207        ]
 208
 209 testh = HU.runTestTT $ HU.TestList allt
 210 testv = runVerbTestText (HU.putTextToHandle stderr True) $ HU.TestList allt
 211
 212
 213 main =
 214     do testv
 215        return ()
 216