3 # Unit tests for heap implementation
5 # Test the following methods:
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.
27 my ($N, @R, $Q, $ar) = (1);
37 sub Fake::Cache::_heap_move { push @HEAP_MOVE, @_ }
39 my $h = Tie::File::Heap->new(bless [] => 'Fake::Cache');
43 # (3) Are all the methods there?
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";
53 print $good ? "ok $N\n" : "not ok $N\n";
57 # (4) Straight insert and removal FIFO test
60 $h->insert($_, $ar++);
67 ? "ok $N\n" : "not ok $N \# expected ($iota), got (@R)\n";
70 # (5) Remove from empty heap
72 print ! defined $n ? "ok $N\n" : "not ok $N \# expected UNDEF, got $n";
75 # (6) Interleaved insert and removal
80 $h->insert($Q, "b$Q");
88 print "@R" eq $iota ? "ok $N\n" : "not ok $N \# expected ($iota), got (@R)\n";
91 # (7) It should be empty now
92 print $h->is_empty ? "ok $N\n" : "not ok $N\n";
95 # (8) Insert and delete
98 $h->insert($_, "c$Q");
101 for (2, 4, 6, 8, 10) {
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";
110 # (9) Interleaved insert and delete
115 $h->insert($Q, "d$Q");
119 $h->remove($QQ) if $QQ % 2 == 0;
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";
131 $h->insert($_, "e$Q");
134 for (2, 4, 6, 8, 10) {
138 push @R, $n while defined ($n = $h->popheap);
139 print "@R" eq "e1 e3 e5 e7 e9 e2 e4 e6 e8 e10" ?
141 "not ok $N \# expected (e1 e3 e5 e7 e9 e2 e4 e6 e8 e10), got (@R)\n";
147 $h->insert($_, "f$Q");
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";
156 # (16) It shouldn't be empty
157 print ! $h->is_empty ? "ok $N\n" : "not ok $N\n";
160 # (17) Lookup should have promoted the looked-up records
162 push @R, $n while defined ($n = $h->popheap);
163 print "@R" eq "f1 f3 f5 f7 f9 f10 f2 f6 f4 f8" ?
165 "not ok $N \# expected (f1 f3 f5 f7 f9 f10 f2 f6 f4 f8), got (@R)\n";
168 # (18-19) Typical 'rekey' operation
171 $h->insert($_, "g$Q");
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);
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";
188 print $good ? "ok $N\n" : "not ok $N\n";
194 my $v = $h->lookup($k);
196 print "# looked up $k, got $v, should have been undef\n";
200 print $good ? "ok $N\n" : "not ok $N\n";
205 @R = sort { $a <=> $b } $h->keys;
206 print "@R" eq "1 2 3 4 5 8 9 10 11 12" ?
208 "not ok $N \# expected (1 2 3 4 5 8 9 10 11 12) got (@R)\n";
213 $h->update($_, "h$_");
216 for (sort { $a <=> $b } $h->keys) {
217 push @R, $h->lookup($_);
219 print "@R" eq "h1 h2 h3 h4 h5 h8 h9 h10 h11 h12" ?
221 "not ok $N \# expected (h1 h2 h3 h4 h5 h8 h9 h10 h11 h12) got (@R)\n";
227 print $B == 23 ? "ok $N\n" : "not ok $N \# expected 23, got $B\n";
229 $h->update('12', "yobgorgle");
231 print $B == 29 ? "ok $N\n" : "not ok $N \# expected 29, got $B\n";
236 print $h->is_empty ? "ok $N\n" : "not ok $N\n";
239 print ! defined $n ? "ok $N\n" : "not ok $N \# expected UNDEF, got $n";
242 # (26) very weak testing of DESTROY
244 # are we still alive?