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.
20
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.
24print "1..1\n";
25
26
27my ($N, @R, $Q, $ar) = (1);
28
29use Tie::File;
30print "ok $N\n";
31$N++;
32exit;
33
34__END__
35
36my @HEAP_MOVE;
37sub Fake::Cache::_heap_move { push @HEAP_MOVE, @_ }
38
39my $h = Tie::File::Heap->new(bless [] => 'Fake::Cache');
40print "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';
59for (1..10) {
60  $h->insert($_, $ar++);
61}
62for (1..10) {
63  push @R, $h->popheap;
64}
65$iota = iota('a',9);
66print "@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;
72print ! 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 = ();
78for 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);
88print "@R" eq $iota ? "ok $N\n" : "not ok $N \# expected ($iota), got (@R)\n";
89$N++;
90
91# (7) It should be empty now
92print $h->is_empty ? "ok $N\n" : "not ok $N\n";
93$N++;
94
95# (8) Insert and delete
96$Q = 1;
97for (1..10) {
98  $h->insert($_, "c$Q");
99  $Q++;
100}
101for (2, 4, 6, 8, 10) {
102  $h->remove($_);
103}
104@R = ();
105push @R, $n while defined ($n = $h->popheap);
106print "@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 = ();
113for 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}
123push @R, $n while defined ($n = $h->popheap);
124print "@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;
130for (1..10) {
131  $h->insert($_, "e$Q");
132  $Q++;
133}
134for (2, 4, 6, 8, 10) {
135  $h->promote($_);
136}
137@R = ();
138push @R, $n while defined ($n = $h->popheap);
139print "@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;
146for (1..10) {
147  $h->insert($_, "f$Q");
148  $Q++;
149}
150for (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
157print ! $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 = ();
162push @R, $n while defined ($n = $h->popheap);
163print "@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;
170for (1..10) {
171  $h->insert($_, "g$Q");
172  $Q++;
173}
174
175$h->rekey([6,7,8,9,10], [8,9,10,11,12]);
176my %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;
206print "@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
212for (1..5, 8..12) {
213  $h->update($_, "h$_");
214}
215@R = ();
216for (sort { $a <=> $b } $h->keys) {
217  push @R, $h->lookup($_);
218}
219print "@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
225my $B;
226$B = $h->bytes;
227print $B == 23 ? "ok $N\n" : "not ok $N \# expected 23, got $B\n";
228$N++;
229$h->update('12', "yobgorgle");
230$B = $h->bytes;
231print $B == 29 ? "ok $N\n" : "not ok $N \# expected 29, got $B\n";
232$N++;
233
234# (24-25) empty
235$h->empty;
236print $h->is_empty ? "ok $N\n" : "not ok $N\n";
237$N++;
238$n = $h->popheap;
239print ! defined $n ? "ok $N\n" : "not ok $N \# expected UNDEF, got $n";
240$N++;
241
242# (26) very weak testing of DESTROY
243undef $h;
244# are we still alive?
245print "ok $N\n";
246$N++;
247
248
249sub 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}
260