Commit | Line | Data |
da49d499 |
1 | #!/usr/bin/perl |
2 | # |
3 | # Unit tests for heap implementation |
4 | # |
5 | # Test the following methods: |
6 | # new |
7 | # is_empty |
8 | # empty |
9 | # insert |
10 | # remove |
11 | # popheap |
12 | # promote |
13 | # lookup |
14 | # set_val |
15 | # rekey |
16 | # expire_order |
17 | |
18 | |
19 | # Finish these later. |
da49d499 |
20 | |
0bf62e3b |
21 | # They're nonurgent because the important heap stuff is extensively |
22 | # tested by tests 19, 20, 24, 30, 32, 33, and 40, as well as by pretty |
23 | # much everything else. |
24 | print "1..1\n"; |
da49d499 |
25 | |
26 | |
27 | my ($N, @R, $Q, $ar) = (1); |
28 | |
29 | use Tie::File; |
30 | print "ok $N\n"; |
31 | $N++; |
0bf62e3b |
32 | exit; |
da49d499 |
33 | |
34 | __END__ |
da49d499 |
35 | |
36 | my @HEAP_MOVE; |
37 | sub Fake::Cache::_heap_move { push @HEAP_MOVE, @_ } |
38 | |
39 | my $h = Tie::File::Heap->new(bless [] => 'Fake::Cache'); |
40 | print "ok $N\n"; |
41 | $N++; |
42 | |
43 | # (3) Are all the methods there? |
44 | { |
45 | my $good = 1; |
46 | for my $meth (qw(new is_empty empty lookup insert remove popheap |
47 | promote set_val rekey expire_order)) { |
48 | unless ($h->can($meth)) { |
49 | print STDERR "# Method '$meth' is missing.\n"; |
50 | $good = 0; |
51 | } |
52 | } |
53 | print $good ? "ok $N\n" : "not ok $N\n"; |
54 | $N++; |
55 | } |
56 | |
57 | # (4) Straight insert and removal FIFO test |
58 | $ar = 'a0'; |
59 | for (1..10) { |
60 | $h->insert($_, $ar++); |
61 | } |
62 | for (1..10) { |
63 | push @R, $h->popheap; |
64 | } |
65 | $iota = iota('a',9); |
66 | print "@R" eq $iota |
67 | ? "ok $N\n" : "not ok $N \# expected ($iota), got (@R)\n"; |
68 | $N++; |
69 | |
70 | # (5) Remove from empty heap |
71 | $n = $h->popheap; |
72 | print ! defined $n ? "ok $N\n" : "not ok $N \# expected UNDEF, got $n"; |
73 | $N++; |
74 | |
75 | # (6) Interleaved insert and removal |
76 | $Q = 0; |
77 | @R = (); |
78 | for my $i (1..4) { |
79 | for my $j (1..$i) { |
80 | $h->insert($Q, "b$Q"); |
81 | $Q++; |
82 | } |
83 | for my $j (1..$i) { |
84 | push @R, $h->popheap; |
85 | } |
86 | } |
87 | $iota = iota('b', 9); |
88 | print "@R" eq $iota ? "ok $N\n" : "not ok $N \# expected ($iota), got (@R)\n"; |
89 | $N++; |
90 | |
91 | # (7) It should be empty now |
92 | print $h->is_empty ? "ok $N\n" : "not ok $N\n"; |
93 | $N++; |
94 | |
95 | # (8) Insert and delete |
96 | $Q = 1; |
97 | for (1..10) { |
98 | $h->insert($_, "c$Q"); |
99 | $Q++; |
100 | } |
101 | for (2, 4, 6, 8, 10) { |
102 | $h->remove($_); |
103 | } |
104 | @R = (); |
105 | push @R, $n while defined ($n = $h->popheap); |
106 | print "@R" eq "c1 c3 c5 c7 c9" ? |
107 | "ok $N\n" : "not ok $N \# expected (c1 c3 c5 c7 c9), got (@R)\n"; |
108 | $N++; |
109 | |
110 | # (9) Interleaved insert and delete |
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->popheap); |
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++; |
127 | |
128 | # (10) Promote |
129 | $Q = 1; |
130 | for (1..10) { |
131 | $h->insert($_, "e$Q"); |
132 | $Q++; |
133 | } |
134 | for (2, 4, 6, 8, 10) { |
135 | $h->promote($_); |
136 | } |
137 | @R = (); |
138 | push @R, $n while defined ($n = $h->popheap); |
139 | print "@R" eq "e1 e3 e5 e7 e9 e2 e4 e6 e8 e10" ? |
140 | "ok $N\n" : |
141 | "not ok $N \# expected (e1 e3 e5 e7 e9 e2 e4 e6 e8 e10), got (@R)\n"; |
142 | $N++; |
143 | |
144 | # (11-15) Lookup |
145 | $Q = 1; |
146 | for (1..10) { |
147 | $h->insert($_, "f$Q"); |
148 | $Q++; |
149 | } |
150 | for (2, 4, 6, 4, 8) { |
151 | my $r = $h->lookup($_); |
152 | print $r eq "f$_" ? "ok $N\n" : "not ok $N \# expected f$_, got $r\n"; |
153 | $N++; |
154 | } |
155 | |
156 | # (16) It shouldn't be empty |
157 | print ! $h->is_empty ? "ok $N\n" : "not ok $N\n"; |
158 | $N++; |
159 | |
160 | # (17) Lookup should have promoted the looked-up records |
161 | @R = (); |
162 | push @R, $n while defined ($n = $h->popheap); |
163 | print "@R" eq "f1 f3 f5 f7 f9 f10 f2 f6 f4 f8" ? |
164 | "ok $N\n" : |
165 | "not ok $N \# expected (f1 f3 f5 f7 f9 f10 f2 f6 f4 f8), got (@R)\n"; |
166 | $N++; |
167 | |
168 | # (18-19) Typical 'rekey' operation |
169 | $Q = 1; |
170 | for (1..10) { |
171 | $h->insert($_, "g$Q"); |
172 | $Q++; |
173 | } |
174 | |
175 | $h->rekey([6,7,8,9,10], [8,9,10,11,12]); |
176 | my %x = qw(1 g1 2 g2 3 g3 4 g4 5 g5 |
177 | 8 g6 9 g7 10 g8 11 g9 12 g10); |
178 | { |
179 | my $good = 1; |
180 | for my $k (keys %x) { |
181 | my $v = $h->lookup($k); |
182 | $v = "UNDEF" unless defined $v; |
183 | unless ($v eq $x{$k}) { |
184 | print "# looked up $k, got $v, expected $x{$k}\n"; |
185 | $good = 0; |
186 | } |
187 | } |
188 | print $good ? "ok $N\n" : "not ok $N\n"; |
189 | $N++; |
190 | } |
191 | { |
192 | my $good = 1; |
193 | for my $k (6, 7) { |
194 | my $v = $h->lookup($k); |
195 | if (defined $v) { |
196 | print "# looked up $k, got $v, should have been undef\n"; |
197 | $good = 0; |
198 | } |
199 | } |
200 | print $good ? "ok $N\n" : "not ok $N\n"; |
201 | $N++; |
202 | } |
203 | |
204 | # (20) keys |
205 | @R = sort { $a <=> $b } $h->keys; |
206 | print "@R" eq "1 2 3 4 5 8 9 10 11 12" ? |
207 | "ok $N\n" : |
208 | "not ok $N \# expected (1 2 3 4 5 8 9 10 11 12) got (@R)\n"; |
209 | $N++; |
210 | |
211 | # (21) update |
212 | for (1..5, 8..12) { |
213 | $h->update($_, "h$_"); |
214 | } |
215 | @R = (); |
216 | for (sort { $a <=> $b } $h->keys) { |
217 | push @R, $h->lookup($_); |
218 | } |
219 | print "@R" eq "h1 h2 h3 h4 h5 h8 h9 h10 h11 h12" ? |
220 | "ok $N\n" : |
221 | "not ok $N \# expected (h1 h2 h3 h4 h5 h8 h9 h10 h11 h12) got (@R)\n"; |
222 | $N++; |
223 | |
224 | # (22-23) bytes |
225 | my $B; |
226 | $B = $h->bytes; |
227 | print $B == 23 ? "ok $N\n" : "not ok $N \# expected 23, got $B\n"; |
228 | $N++; |
229 | $h->update('12', "yobgorgle"); |
230 | $B = $h->bytes; |
231 | print $B == 29 ? "ok $N\n" : "not ok $N \# expected 29, got $B\n"; |
232 | $N++; |
233 | |
234 | # (24-25) empty |
235 | $h->empty; |
236 | print $h->is_empty ? "ok $N\n" : "not ok $N\n"; |
237 | $N++; |
238 | $n = $h->popheap; |
239 | print ! defined $n ? "ok $N\n" : "not ok $N \# expected UNDEF, got $n"; |
240 | $N++; |
241 | |
242 | # (26) very weak testing of DESTROY |
243 | undef $h; |
244 | # are we still alive? |
245 | print "ok $N\n"; |
246 | $N++; |
247 | |
248 | |
249 | sub iota { |
250 | my ($p, $n) = @_; |
251 | my $r; |
252 | my $i = 0; |
253 | while ($i <= $n) { |
254 | $r .= "$p$i "; |
255 | $i++; |
256 | } |
257 | chop $r; |
258 | $r; |
259 | } |