dist/Tie-File/t/41_heap.t

   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.
  24 print "1..1\n";
  25
  26
  27 my ($N, @R, $Q, $ar) = (1);
  28
  29 use Tie::File;
  30 print "ok $N\n";
  31 $N++;
  32 exit;
  33
  34 __END__
  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 }