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