2 Copyright (C) 2002-2008 John Goerzen <jgoerzen@complete.org>
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.
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.
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
18 module TestSyncable where
19 import Data.Maybe(catMaybes)
21 import qualified Data.Map as Map
23 import qualified Test.HUnit as HU
24 import Test.HUnit.Utils
26 import Test.QuickCheck
27 import TestInfrastructure
31 syncBiDir (emptymap::Map.Map Int ()) emptymap emptymap == ([], []) -- ([DeleteItem 5], [], [])
33 prop_delAllFromChild :: SyncCollection Int () -> Result
34 prop_delAllFromChild inp =
35 let (resMaster, resChild) = syncBiDir emptymap inp inp
36 expectedResChild = sort . map DeleteItem . Map.keys $ inp
37 in ([], expectedResChild) @=?
38 (resMaster, sort resChild)
40 prop_delAllFromMaster :: SyncCollection Int () -> Result
41 prop_delAllFromMaster inp =
42 let (resMaster, resChild) = syncBiDir inp emptymap inp
43 expectedResMaster = sort . map DeleteItem . Map.keys $ inp
44 in (expectedResMaster, []) @=?
45 (sort resMaster, resChild)
47 prop_addFromMaster :: SyncCollection Int Word8 -> Result
48 prop_addFromMaster inp =
49 let (resMaster, resChild) = syncBiDir inp emptymap emptymap
50 expectedResChild = sort . map (\(k, v) -> CopyItem k v) . Map.toList $ inp
51 in ([], expectedResChild) @=?
52 (resMaster, sort resChild)
54 -- FIXME: prop_addFromChild
56 prop_allChangesToChild :: SyncCollection Int Word8 -> SyncCollection Int Word8 -> Result
57 prop_allChangesToChild master child =
58 let (resMaster, resChild) = syncBiDir master child child
59 expectedResChild = sort $
60 (map (\(k, v) -> CopyItem k v) . Map.toList . Map.difference master $ child) ++
61 (map DeleteItem . Map.keys . Map.difference child $ master) ++
62 (map (pairToFunc SetContent) changeList)
63 changeList = foldl changefunc [] (Map.toList child)
64 changefunc accum (k, v) =
65 case Map.lookup k master of
70 in ([], expectedResChild) @=?
71 (sort resMaster, sort resChild)
73 prop_allChangesToMaster :: SyncCollection Int Word8 -> SyncCollection Int Word8 -> Result
74 prop_allChangesToMaster master child =
75 let (resMaster, resChild) = syncBiDir master child master
76 expectedResMaster = sort $
77 (map (pairToFunc CopyItem) . Map.toList . Map.difference child $ master) ++
78 (map DeleteItem . Map.keys . Map.difference master $ child) ++
79 (map (pairToFunc SetContent) changeList)
80 changeList = foldl changefunc [] (Map.toList child)
81 changefunc accum (k, v) =
82 case Map.lookup k master of
87 in (expectedResMaster, []) @=?
88 (sort resMaster, resChild)
90 -- FIXME: test findModified
92 prop_allChanges :: SyncCollection Int Word8 -> SyncCollection Int Word8 -> SyncCollection Int Word8 -> Result
93 prop_allChanges master child lastchild =
94 let (resMaster, resChild) = syncBiDir master child lastchild
96 masterMods = catMaybes . map procKV $ (Map.toList master)
98 case (Map.lookup k child, Map.lookup k lastchild) of
100 if c == lc -- child didn't change
102 else if c == m -- child and master changed
104 else Just (k, c) -- child changed, master didn't
105 (Nothing, Just lc) -> Nothing -- deleted on child
106 (Just c, Nothing) -> -- New on both c and m
107 if c == m -- Added the same
109 else Just (k, c) -- Added but differ
110 (Nothing, Nothing) -> Nothing -- New to master only
112 childMods = catMaybes . map procKV $ (Map.toList child)
113 where procKV (k, c) =
114 case (Map.lookup k master, Map.lookup k lastchild) of
121 (Nothing, Just lc) -> -- deleted; nothing to see here
123 (Just m, Nothing) -> -- New on both; child takes precedence
125 (Nothing, Nothing) -> Nothing -- New to child only
127 expectedResMaster = sort $
128 (map (pairToFunc CopyItem) . Map.toList . Map.difference child $ Map.union master lastchild) ++
129 (map DeleteItem . Map.keys . Map.intersection master $ Map.difference lastchild child) ++
130 (map (pairToFunc SetContent) masterMods)
132 expectedResChild = sort $
133 (map (pairToFunc CopyItem) . Map.toList . Map.difference master $ Map.union child lastchild) ++
134 (map DeleteItem . Map.keys . Map.intersection child $ Map.difference lastchild master) ++
135 (map (pairToFunc SetContent) childMods)
137 in (expectedResMaster, expectedResChild) @=?
138 (sort resMaster, sort resChild)
140 {- | Basic validation that unaryApplyChanges works -}
141 prop_unaryApplyChanges :: SyncCollection Int Word8 -> [(Bool, Int, Word8)] -> Result
142 prop_unaryApplyChanges collection randcommands =
143 let -- We use nubBy to make sure we don't get input that has reference
144 -- to the same key more than once. We then convert True/False to
146 commands = map toCommand . nubBy (\(x1, y1, z1) (x2, y2, z2) -> y1 == y2) $ randcommands
147 toCommand (True, x, v) = CopyItem x v
148 toCommand (False, x, _) = DeleteItem x
150 addedItems = catMaybes . map (\x -> case x of CopyItem y v -> Just (y, v); _ -> Nothing) $ commands
151 deletedKeys = catMaybes . map (\x -> case x of DeleteItem y -> Just y; _ -> Nothing) $ commands
153 collection' = foldl (flip Map.delete) collection deletedKeys
155 Map.union collection' (Map.fromList addedItems)
156 in (sort . Map.keys $ expectedCollection) @=?
157 (sort . Map.keys $ unaryApplyChanges collection commands)
159 {- | Should validate both that unaryApplyChanges works, and that it is
161 prop_unaryApplyChangesId :: SyncCollection Int Word8 -> SyncCollection Int Word8 -> Result
162 prop_unaryApplyChangesId master child =
163 let (resMaster, resChild) = syncBiDir master child child
164 newMaster = unaryApplyChanges master resMaster
165 newChild = unaryApplyChanges child resChild
166 newMasterKeys = sort . Map.keys $ newMaster
167 newChildKeys = sort . Map.keys $ newChild
168 in (True, sort (Map.keys master), sort (Map.keys master)) @=?
169 (newMasterKeys == newChildKeys, newMasterKeys, newChildKeys)
171 prop_unaryApplyChanges3 :: SyncCollection Int Word8 -> SyncCollection Int Word8 -> SyncCollection Int Word8 -> Result
172 prop_unaryApplyChanges3 master child lastChild =
173 let (resMaster, resChild) = syncBiDir master child lastChild
174 newMaster = unaryApplyChanges master resMaster
175 newChild = unaryApplyChanges child resChild
176 in newMaster @=? newChild
178 prop_diffCollection :: SyncCollection Int Word8 -> SyncCollection Int Word8 -> Result
179 prop_diffCollection coll1 coll2 =
180 let commands = diffCollection coll1 coll2
181 newcoll2 = unaryApplyChanges coll1 commands
182 in coll2 @=? newcoll2
184 allt = [q "Empty" prop_empty,
185 q "Del all from child" prop_delAllFromChild,
186 q "Del all from master" prop_delAllFromMaster,
187 q "Add from master" prop_addFromMaster,
188 q "All changes to child" prop_allChangesToChild,
189 q "All changes to master" prop_allChangesToMaster,
190 q "All changes" prop_allChanges,
191 q "unaryApplyChanges" prop_unaryApplyChanges,
192 q "unaryApplyChangesId" prop_unaryApplyChangesId,
193 q "unaryApplyChanges3" prop_unaryApplyChanges3,
194 q "diffCollection" prop_diffCollection