Commit | Line | Data |
6fc0ea7e |
1 | #!/usr/bin/perl |
2 | # |
3 | # Unit tests for abstract cache implementation |
4 | # |
5 | # Test the following methods: |
6 | # * new() |
7 | # * is_empty() |
8 | # * empty() |
9 | # * lookup(key) |
10 | # * remove(key) |
11 | # * insert(key,val) |
12 | # * update(key,val) |
13 | # * rekey(okeys,nkeys) |
14 | # * expire() |
15 | # * keys() |
16 | # * bytes() |
17 | # DESTROY() |
18 | # |
19 | # 20020327 You somehow managed to miss: |
20 | # * reduce_size_to(bytes) |
21 | # |
22 | |
23 | # print "1..0\n"; exit; |
bf919750 |
24 | print "1..42\n"; |
6fc0ea7e |
25 | |
26 | my ($N, @R, $Q, $ar) = (1); |
27 | |
28 | use Tie::File; |
29 | print "ok $N\n"; |
30 | $N++; |
31 | |
32 | my $h = Tie::File::Cache->new(10000) or die; |
33 | print "ok $N\n"; |
34 | $N++; |
35 | |
36 | # (3) Are all the methods there? |
37 | { |
38 | my $good = 1; |
39 | for my $meth (qw(new is_empty empty lookup remove |
bf919750 |
40 | insert update rekey expire ckeys bytes |
6fc0ea7e |
41 | set_limit adj_limit flush reduce_size_to |
42 | _produce _produce_lru )) { |
43 | unless ($h->can($meth)) { |
44 | print STDERR "# Method '$meth' is missing.\n"; |
45 | $good = 0; |
46 | } |
47 | } |
48 | print $good ? "ok $N\n" : "not ok $N\n"; |
49 | $N++; |
50 | } |
51 | |
bf919750 |
52 | # (4-5) Straight insert and removal FIFO test |
6fc0ea7e |
53 | $ar = 'a0'; |
54 | for (1..10) { |
55 | $h->insert($_, $ar++); |
56 | } |
57 | 1; |
58 | for (1..10) { |
59 | push @R, $h->expire; |
60 | } |
61 | $iota = iota('a',9); |
62 | print "@R" eq $iota |
63 | ? "ok $N\n" : "not ok $N \# expected ($iota), got (@R)\n"; |
64 | $N++; |
bf919750 |
65 | check($h); |
6fc0ea7e |
66 | |
bf919750 |
67 | # (6-7) Remove from empty heap |
6fc0ea7e |
68 | $n = $h->expire; |
69 | print ! defined $n ? "ok $N\n" : "not ok $N \# expected UNDEF, got $n"; |
70 | $N++; |
bf919750 |
71 | check($h); |
6fc0ea7e |
72 | |
bf919750 |
73 | # (8-9) Interleaved insert and removal |
6fc0ea7e |
74 | $Q = 0; |
75 | @R = (); |
76 | for my $i (1..4) { |
77 | for my $j (1..$i) { |
78 | $h->insert($Q, "b$Q"); |
79 | $Q++; |
80 | } |
81 | for my $j (1..$i) { |
82 | push @R, $h->expire; |
83 | } |
84 | } |
85 | $iota = iota('b', 9); |
86 | print "@R" eq $iota ? "ok $N\n" : "not ok $N \# expected ($iota), got (@R)\n"; |
87 | $N++; |
bf919750 |
88 | check($h); |
6fc0ea7e |
89 | |
bf919750 |
90 | # (10) It should be empty now |
6fc0ea7e |
91 | print $h->is_empty ? "ok $N\n" : "not ok $N\n"; |
92 | $N++; |
93 | |
bf919750 |
94 | # (11-12) Insert and delete |
6fc0ea7e |
95 | $Q = 1; |
96 | for (1..10) { |
97 | $h->insert($_, "c$Q"); |
98 | $Q++; |
99 | } |
100 | for (2, 4, 6, 8, 10) { |
101 | $h->remove($_); |
102 | } |
103 | @R = (); |
104 | push @R, $n while defined ($n = $h->expire); |
105 | print "@R" eq "c1 c3 c5 c7 c9" ? |
106 | "ok $N\n" : "not ok $N \# expected (c1 c3 c5 c7 c9), got (@R)\n"; |
107 | $N++; |
bf919750 |
108 | check($h); |
6fc0ea7e |
109 | |
bf919750 |
110 | # (13-14) Interleaved insert and delete |
6fc0ea7e |
111 | $Q = 1; my $QQ = 1; |
112 | @R = (); |
113 | for my $i (1..4) { |
114 | for my $j (1..$i) { |
115 | $h->insert($Q, "d$Q"); |
116 | $Q++; |
117 | } |
118 | for my $j (1..$i) { |
119 | $h->remove($QQ) if $QQ % 2 == 0; |
120 | $QQ++; |
121 | } |
122 | } |
123 | push @R, $n while defined ($n = $h->expire); |
124 | print "@R" eq "d1 d3 d5 d7 d9" ? |
125 | "ok $N\n" : "not ok $N \# expected (d1 d3 d5 d7 d9), got (@R)\n"; |
126 | $N++; |
bf919750 |
127 | check($h); |
6fc0ea7e |
128 | |
bf919750 |
129 | # (15-16) Promote |
6fc0ea7e |
130 | $h->empty; |
131 | $Q = 1; |
132 | for (1..10) { |
133 | $h->insert($_, "e$Q"); |
134 | unless ($h->_check_integrity) { |
135 | die "Integrity failed after inserting ($_, e$Q)\n"; |
136 | } |
137 | $Q++; |
138 | } |
139 | 1; |
140 | for (2, 4, 6, 8, 10) { |
141 | $h->_promote($_); |
142 | } |
143 | @R = (); |
144 | push @R, $n while defined ($n = $h->expire); |
145 | print "@R" eq "e1 e3 e5 e7 e9 e2 e4 e6 e8 e10" ? |
146 | "ok $N\n" : |
147 | "not ok $N \# expected (e1 e3 e5 e7 e9 e2 e4 e6 e8 e10), got (@R)\n"; |
148 | $N++; |
bf919750 |
149 | check($h); |
6fc0ea7e |
150 | |
bf919750 |
151 | # (17-22) Lookup |
6fc0ea7e |
152 | $Q = 1; |
153 | for (1..10) { |
154 | $h->insert($_, "f$Q"); |
155 | $Q++; |
156 | } |
157 | 1; |
158 | for (2, 4, 6, 4, 8) { |
159 | my $r = $h->lookup($_); |
160 | print $r eq "f$_" ? "ok $N\n" : "not ok $N \# expected f$_, got $r\n"; |
161 | $N++; |
162 | } |
bf919750 |
163 | check($h); |
6fc0ea7e |
164 | |
bf919750 |
165 | # (23) It shouldn't be empty |
6fc0ea7e |
166 | print ! $h->is_empty ? "ok $N\n" : "not ok $N\n"; |
167 | $N++; |
168 | |
bf919750 |
169 | # (24-25) Lookup should have promoted the looked-up records |
6fc0ea7e |
170 | @R = (); |
171 | push @R, $n while defined ($n = $h->expire); |
172 | print "@R" eq "f1 f3 f5 f7 f9 f10 f2 f6 f4 f8" ? |
173 | "ok $N\n" : |
174 | "not ok $N \# expected (f1 f3 f5 f7 f9 f10 f2 f6 f4 f8), got (@R)\n"; |
175 | $N++; |
bf919750 |
176 | check($h); |
6fc0ea7e |
177 | |
bf919750 |
178 | # (26-29) Typical 'rekey' operation |
6fc0ea7e |
179 | $Q = 1; |
180 | for (1..10) { |
181 | $h->insert($_, "g$Q"); |
182 | $Q++; |
183 | } |
184 | $h->rekey([6,7,8,9,10], [8,9,10,11,12]); |
185 | my %x = qw(1 g1 2 g2 3 g3 4 g4 5 g5 |
186 | 8 g6 9 g7 10 g8 11 g9 12 g10); |
187 | { |
188 | my $good = 1; |
189 | for my $k (keys %x) { |
190 | my $v = $h->lookup($k); |
191 | $v = "UNDEF" unless defined $v; |
192 | unless ($v eq $x{$k}) { |
193 | print "# looked up $k, got $v, expected $x{$k}\n"; |
194 | $good = 0; |
195 | } |
196 | } |
197 | print $good ? "ok $N\n" : "not ok $N\n"; |
198 | $N++; |
199 | } |
bf919750 |
200 | check($h); |
6fc0ea7e |
201 | { |
202 | my $good = 1; |
203 | for my $k (6, 7) { |
204 | my $v = $h->lookup($k); |
205 | if (defined $v) { |
206 | print "# looked up $k, got $v, should have been undef\n"; |
207 | $good = 0; |
208 | } |
209 | } |
210 | print $good ? "ok $N\n" : "not ok $N\n"; |
211 | $N++; |
212 | } |
bf919750 |
213 | check($h); |
6fc0ea7e |
214 | |
bf919750 |
215 | # (30-31) ckeys |
216 | @R = sort { $a <=> $b } $h->ckeys; |
6fc0ea7e |
217 | print "@R" eq "1 2 3 4 5 8 9 10 11 12" ? |
218 | "ok $N\n" : |
219 | "not ok $N \# expected (1 2 3 4 5 8 9 10 11 12) got (@R)\n"; |
220 | $N++; |
bf919750 |
221 | check($h); |
6fc0ea7e |
222 | 1; |
bf919750 |
223 | # (32-33) update |
6fc0ea7e |
224 | for (1..5, 8..12) { |
225 | $h->update($_, "h$_"); |
226 | } |
227 | @R = (); |
bf919750 |
228 | for (sort { $a <=> $b } $h->ckeys) { |
6fc0ea7e |
229 | push @R, $h->lookup($_); |
230 | } |
231 | print "@R" eq "h1 h2 h3 h4 h5 h8 h9 h10 h11 h12" ? |
232 | "ok $N\n" : |
233 | "not ok $N \# expected (h1 h2 h3 h4 h5 h8 h9 h10 h11 h12) got (@R)\n"; |
234 | $N++; |
bf919750 |
235 | check($h); |
6fc0ea7e |
236 | |
bf919750 |
237 | # (34-37) bytes |
6fc0ea7e |
238 | my $B; |
239 | $B = $h->bytes; |
240 | print $B == 23 ? "ok $N\n" : "not ok $N \# expected 23, got $B\n"; |
241 | $N++; |
bf919750 |
242 | check($h); |
6fc0ea7e |
243 | $h->update('12', "yobgorgle"); |
244 | $B = $h->bytes; |
245 | print $B == 29 ? "ok $N\n" : "not ok $N \# expected 29, got $B\n"; |
246 | $N++; |
bf919750 |
247 | check($h); |
6fc0ea7e |
248 | |
bf919750 |
249 | # (38-41) empty |
6fc0ea7e |
250 | $h->empty; |
251 | print $h->is_empty ? "ok $N\n" : "not ok $N\n"; |
252 | $N++; |
bf919750 |
253 | check($h); |
6fc0ea7e |
254 | $n = $h->expire; |
255 | print ! defined $n ? "ok $N\n" : "not ok $N \# expected UNDEF, got $n"; |
256 | $N++; |
bf919750 |
257 | check($h); |
6fc0ea7e |
258 | |
bf919750 |
259 | # (42) very weak testing of DESTROY |
6fc0ea7e |
260 | undef $h; |
261 | # are we still alive? |
262 | print "ok $N\n"; |
263 | $N++; |
264 | |
bf919750 |
265 | sub check { |
266 | my $h = shift; |
267 | print $h->_check_integrity ? "ok $N\n" : "not ok $N\n"; |
268 | $N++; |
269 | } |
6fc0ea7e |
270 | |
271 | sub iota { |
272 | my ($p, $n) = @_; |
273 | my $r; |
274 | my $i = 0; |
275 | while ($i <= $n) { |
276 | $r .= "$p$i "; |
277 | $i++; |
278 | } |
279 | chop $r; |
280 | $r; |
281 | } |