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 import Data.Word
  29
  30 import Data.Syncable
  31 import TestInfrastructure
  32
  33 prop_empty :: Bool
  34 prop_empty =
  35     syncBiDir (emptymap::Map.Map Int ()) emptymap emptymap == ([], []) -- ([DeleteItem 5], [], [])
  36
  37 prop_delAllFromChild :: SyncCollection Int () -> Result
  38 prop_delAllFromChild inp =
  39     let (resMaster, resChild) = syncBiDir emptymap inp inp
  40         expectedResChild = sort . map DeleteItem . Map.keys $ inp
  41         in ([], expectedResChild) @=?
  42            (resMaster, sort resChild)
  43
  44 prop_delAllFromMaster :: SyncCollection Int () -> Result
  45 prop_delAllFromMaster inp =
  46     let (resMaster, resChild) = syncBiDir inp emptymap inp
  47         expectedResMaster = sort . map DeleteItem . Map.keys $ inp
  48         in (expectedResMaster, []) @=?
  49            (sort resMaster, resChild)
  50
  51 prop_addFromMaster :: SyncCollection Int Word8 -> Result
  52 prop_addFromMaster inp =
  53     let (resMaster, resChild) = syncBiDir inp emptymap emptymap
  54         expectedResChild = sort . map (\(k, v) -> CopyItem k v) . Map.toList $ inp
  55         in ([], expectedResChild) @=?
  56            (resMaster, sort resChild)
  57
  58 -- FIXME: prop_addFromChild
  59
  60 prop_allChangesToChild :: SyncCollection Int Word8 -> SyncCollection Int Word8 -> Result
  61 prop_allChangesToChild master child =
  62     let (resMaster, resChild) = syncBiDir master child child
  63         expectedResChild = sort $
  64             (map (\(k, v) -> CopyItem k v) . Map.toList . Map.difference master $ child) ++
  65             (map DeleteItem . Map.keys . Map.difference child $ master) ++
  66             (map (pairToFunc ModifyContent) changeList)
  67         changeList = foldl changefunc [] (Map.toList child)
  68         changefunc accum (k, v) =
  69             case Map.lookup k master of
  70               Nothing -> accum
  71               Just x -> if x /= v
  72                         then (k, x) : accum
  73                         else accum
  74         masterChanges = map (pairToFunc ModifyContent) . catMaybes .
  75                         map checkIt . Map.toList . Map.intersection child
  76                             $ master
  77             where checkIt (k, v) =
  78                       case Map.lookup k master of
  79                         Nothing -> Nothing
  80                         Just v' -> if v /= v'
  81                                    then Just (k, v)
  82                                    else Nothing
  83         in (sort masterChanges, expectedResChild) @=?
  84            (sort resMaster, sort resChild)
  85
  86 prop_allChangesToMaster :: SyncCollection Int Word8 -> SyncCollection Int Word8 -> Result
  87 prop_allChangesToMaster master child =
  88     let (resMaster, resChild) = syncBiDir master child master
  89         expectedResMaster = sort $
  90             (map (pairToFunc CopyItem) . Map.toList . Map.difference child $ master) ++
  91             (map DeleteItem . Map.keys . Map.difference master $ child) ++
  92             (map (pairToFunc ModifyContent) changeList)
  93         changeList = foldl changefunc [] (Map.toList child)
  94         changefunc accum (k, v) =
  95             case Map.lookup k master of
  96               Nothing -> accum
  97               Just x -> if x /= v
  98                         then (k, v) : accum
  99                         else accum
 100         in (expectedResMaster, []) @=?
 101            (sort resMaster, resChild)
 102
 103 -- FIXME: test findModified
 104
 105 prop_allChanges :: SyncCollection Int Word8 -> SyncCollection Int Word8 -> SyncCollection Int Word8 -> Result
 106 prop_allChanges master child lastchild =
 107     let (resMaster, resChild) = syncBiDir master child lastchild
 108
 109         masterMods = catMaybes . map procKV $ (Map.toList master)
 110             where procKV (k, m) =
 111                       case (Map.lookup k child, Map.lookup k lastchild) of
 112                         (Just c, Just lc) ->
 113                             if c == lc -- child didn't change
 114                                then Nothing
 115                                else if c == m -- child and master changed
 116                                     then Nothing
 117                                     else Just (k, c) -- child changed, master didn't
 118                         (Nothing, Just lc) -> Nothing -- deleted on child
 119                         (Just c, Nothing) -> -- New on both c and m
 120                             if c == m        -- Added the same
 121                                then Nothing
 122                                else Just (k, c) -- Added but differ
 123                         (Nothing, Nothing) -> Nothing -- New to master only
 124
 125         childMods = catMaybes . map procKV $ (Map.toList child)
 126             where procKV (k, c) =
 127                       case (Map.lookup k master, Map.lookup k lastchild) of
 128                         (Just m, Just lc) ->
 129                             if lc == c
 130                                then if c == m
 131                                        then Nothing
 132                                        else Just (k, m)
 133                                else Nothing
 134                         (Nothing, Just lc) ->        -- deleted; nothing to see here
 135                                               Nothing
 136                         (Just m, Nothing) -> -- New on both; child takes precedence
 137                            Nothing
 138                         (Nothing, Nothing) -> Nothing -- New to child only
 139
 140         expectedResMaster = sort $
 141             (map (pairToFunc CopyItem) . Map.toList . Map.difference child $ Map.union master lastchild) ++
 142                                                                                             (map DeleteItem . Map.keys . Map.intersection master $ Map.difference lastchild child) ++
 143             (map (pairToFunc ModifyContent) masterMods)
 144
 145         expectedResChild = sort $
 146             (map (pairToFunc CopyItem) . Map.toList . Map.difference master $ Map.union child lastchild) ++
 147                                                                                             (map DeleteItem . Map.keys . Map.intersection child $ Map.difference lastchild master) ++
 148             (map (pairToFunc ModifyContent) childMods)
 149
 150     in (expectedResMaster, expectedResChild) @=?
 151        (sort resMaster, sort resChild)
 152
 153 {- | Basic validation that unaryApplyChanges works -}
 154 prop_unaryApplyChanges :: SyncCollection Int Word8 -> [(Bool, Int, Word8)] -> Result
 155 prop_unaryApplyChanges collection randcommands =
 156     let -- We use nubBy to make sure we don't get input that has reference
 157         -- to the same key more than once.  We then convert True/False to
 158         -- commands.
 159         commands = map toCommand . nubBy (\(x1, y1, z1) (x2, y2, z2) -> y1 == y2) $ randcommands
 160         toCommand (True, x, v) = CopyItem x v
 161         toCommand (False, x, _) = DeleteItem x
 162
 163         addedItems = catMaybes . map (\x -> case x of CopyItem y v -> Just (y, v); _ -> Nothing) $ commands
 164         deletedKeys = catMaybes . map (\x -> case x of DeleteItem y -> Just y; _ -> Nothing) $ commands
 165
 166         collection' = foldl (flip Map.delete) collection deletedKeys
 167         expectedCollection =
 168             Map.union collection' (Map.fromList addedItems)
 169         in (sort . Map.keys $ expectedCollection) @=?
 170            (sort . Map.keys $ unaryApplyChanges collection commands)
 171
 172 {- | Should validate both that unaryApplyChanges works, and that it is
 173 an identify -}
 174 prop_unaryApplyChangesId :: SyncCollection Int Word8 -> SyncCollection Int Word8 -> Result
 175 prop_unaryApplyChangesId master child =
 176     let (resMaster, resChild) = syncBiDir master child child
 177         newMaster = unaryApplyChanges master resMaster
 178         newChild = unaryApplyChanges child resChild
 179         newMasterKeys = sort . Map.keys $ newMaster
 180         newChildKeys = sort . Map.keys $ newChild
 181         in (True, sort (Map.keys master), sort (Map.keys master)) @=?
 182            (newMasterKeys == newChildKeys, newMasterKeys, newChildKeys)
 183
 184 prop_unaryApplyChanges3 :: SyncCollection Int Word8 -> SyncCollection Int Word8 -> SyncCollection Int Word8 -> Result
 185 prop_unaryApplyChanges3 master child lastChild =
 186     let (resMaster, resChild) = syncBiDir master child lastChild
 187         newMaster = unaryApplyChanges master resMaster
 188         newChild = unaryApplyChanges child resChild
 189     in newMaster @=? newChild
 190
 191 prop_diffCollection :: SyncCollection Int Word8 -> SyncCollection Int Word8 -> Result
 192 prop_diffCollection coll1 coll2 =
 193     let commands = diffCollection coll1 coll2
 194         newcoll2 = unaryApplyChanges coll1 commands
 195         in coll2 @=? newcoll2
 196
 197 q :: Testable a => String -> a -> HU.Test
 198 q = qccheck (defaultConfig {configMaxTest = 250})
 199
 200 allt = [q "Empty" prop_empty,
 201         q "Del all from child" prop_delAllFromChild,
 202         q "Del all from master" prop_delAllFromMaster,
 203         q "Add from master" prop_addFromMaster,
 204         q "All changes to child" prop_allChangesToChild,
 205         q "All changes to master" prop_allChangesToMaster,
 206         q "All changes" prop_allChanges,
 207         q "unaryApplyChanges" prop_unaryApplyChanges,
 208         q "unaryApplyChangesId" prop_unaryApplyChangesId,
 209         q "unaryApplyChanges3" prop_unaryApplyChanges3,
 210         q "diffCollection" prop_diffCollection
 211        ]
 212
 213 testh = HU.runTestTT $ HU.TestList allt
 214 testv = runVerbTestText (HU.putTextToHandle stderr True) $ HU.TestList allt
 215
 216
 217 main =
 218     do testv
 219        return ()
 220