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     syncThem (emptymap::Map.Map Int ()) emptymap emptymap == ([], []) -- ([DeleteItem 5], [], [])
  35
  36 prop_delAllFromChild :: SyncCollection Int -> Result
  37 prop_delAllFromChild inp =
  38     let (resMaster, resChild) = syncThem 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) = syncThem inp emptymap inp
  46         expectedResMaster = sort . map DeleteItem . Map.keys $ inp
  47         in (expectedResMaster, []) @=?
  48            (sort resMaster, resChild)
  49
  50 prop_addFromMaster :: SyncCollection Int -> Result
  51 prop_addFromMaster inp =
  52     let (resMaster, resChild) = syncThem inp emptymap emptymap
  53         expectedResChild = sort . map CopyItem . Map.keys $ inp
  54         in ([], expectedResChild) @=?
  55            (resMaster, sort resChild)
  56
  57 prop_allChangesToChild :: SyncCollection Int -> SyncCollection Int -> Result
  58 prop_allChangesToChild master child =
  59     let (resMaster, resChild) = syncThem master child child
  60         expectedResChild = sort $
  61             (map CopyItem . Map.keys . Map.difference master $ child) ++
  62             (map DeleteItem . Map.keys . Map.difference child $ master)
  63         in ([], expectedResChild) @=?
  64            (resMaster, sort resChild)
  65
  66 prop_allChangesToMaster :: SyncCollection Int -> SyncCollection Int -> Result
  67 prop_allChangesToMaster master child =
  68     let (resMaster, resChild) = syncThem master child master
  69         expectedResMaster = sort $
  70             (map CopyItem . Map.keys . Map.difference child $ master) ++
  71             (map DeleteItem . Map.keys . Map.difference master $ child)
  72         in (expectedResMaster, []) @=?
  73            (sort resMaster, resChild)
  74
  75 prop_allChanges :: SyncCollection Int -> SyncCollection Int -> SyncCollection Int -> Result
  76 prop_allChanges master child lastchild =
  77     let (resMaster, resChild) = syncThem master child lastchild
  78         expectedResMaster = sort $
  79             (map CopyItem . Map.keys . Map.difference child $ Map.union master lastchild) ++
  80                                                                                             (map DeleteItem . Map.keys . Map.intersection master $ Map.difference lastchild child)
  81         expectedResChild = sort $
  82             (map CopyItem . Map.keys . Map.difference master $ Map.union child lastchild) ++
  83                                                                                             (map DeleteItem . Map.keys . Map.intersection child $ Map.difference lastchild master)
  84     in (expectedResMaster, expectedResChild) @=?
  85        (sort resMaster, sort resChild)
  86
  87 {- | Basic validation that unaryApplyChanges works -}
  88 prop_unaryApplyChanges :: SyncCollection Int -> [(Bool, Int)] -> Result
  89 prop_unaryApplyChanges collection randcommands =
  90     let -- We use nubBy to make sure we don't get input that has reference
  91         -- to the same key more than once.  We then convert True/False to
  92         -- commands.
  93         commands = map toCommand . nubBy (\x y -> snd x == snd y) $ randcommands
  94         toCommand (True, x) = CopyItem x
  95         toCommand (False, x) = DeleteItem x
  96
  97         addedKeys = catMaybes . map (\x -> case x of CopyItem y -> Just y; _ -> Nothing) $ commands
  98         deletedKeys = catMaybes . map (\x -> case x of DeleteItem y -> Just y; _ -> Nothing) $ commands
  99
 100         expectedCollection =
 101             Map.union
 102                    (Map.difference collection (keysToMap deletedKeys))
 103                    (Map.intersection collection (keysToMap addedKeys))
 104         in (sort . Map.keys $ expectedCollection) @=?
 105            (sort . Map.keys $ unaryApplyChanges collection commands)
 106
 107 {- | Should validate both that unaryApplyChanges works, and that it is
 108 an identify -}
 109 prop_unaryApplyChangesId :: SyncCollection Int -> SyncCollection Int -> Result
 110 prop_unaryApplyChangesId master child =
 111     let (resMaster, resChild) = syncThem master child child
 112         newMaster = unaryApplyChanges master resMaster
 113         newChild = unaryApplyChanges child resChild
 114         newMasterKeys = sort . Map.keys $ newMaster
 115         newChildKeys = sort . Map.keys $ newChild
 116         in (True, sort (Map.keys master), sort (Map.keys master)) @=?
 117            (newMasterKeys == newChildKeys, newMasterKeys, newChildKeys)
 118
 119 allt = [qctest "Empty" prop_empty,
 120         qctest "Del all from child" prop_delAllFromChild,
 121         qctest "Del all from master" prop_delAllFromMaster,
 122         qctest "Add from master" prop_addFromMaster,
 123         qctest "All changes to child" prop_allChangesToChild,
 124         qctest "All changes to master" prop_allChangesToMaster,
 125         qctest "All changes" prop_allChanges,
 126         qctest "unaryApplyChanges" prop_unaryApplyChanges,
 127         qctest "unaryApplyChangesId" prop_unaryApplyChangesId
 128        ]
 129
 130 testh = HU.runTestTT $ HU.TestList allt
 131 testv = runVerbTestText (HU.putTextToHandle stderr True) $ HU.TestList allt
 132
 133
 134 main =
 135     do testv
 136        return ()
 137