1N/A#!/usr/bin/perl
1N/A#
1N/A# Unit tests for heap implementation
1N/A#
1N/A# Test the following methods:
1N/A# new
1N/A# is_empty
1N/A# empty
1N/A# insert
1N/A# remove
1N/A# popheap
1N/A# promote
1N/A# lookup
1N/A# set_val
1N/A# rekey
1N/A# expire_order
1N/A
1N/A
1N/A# Finish these later.
1N/A
1N/A# They're nonurgent because the important heap stuff is extensively
1N/A# tested by tests 19, 20, 24, 30, 32, 33, and 40, as well as by pretty
1N/A# much everything else.
1N/Aprint "1..1\n";
1N/A
1N/A
1N/Amy ($N, @R, $Q, $ar) = (1);
1N/A
1N/Ause Tie::File;
1N/Aprint "ok $N\n";
1N/A$N++;
1N/Aexit;
1N/A
1N/A__END__
1N/A
1N/Amy @HEAP_MOVE;
1N/Asub Fake::Cache::_heap_move { push @HEAP_MOVE, @_ }
1N/A
1N/Amy $h = Tie::File::Heap->new(bless [] => 'Fake::Cache');
1N/Aprint "ok $N\n";
1N/A$N++;
1N/A
1N/A# (3) Are all the methods there?
1N/A{
1N/A my $good = 1;
1N/A for my $meth (qw(new is_empty empty lookup insert remove popheap
1N/A promote set_val rekey expire_order)) {
1N/A unless ($h->can($meth)) {
1N/A print STDERR "# Method '$meth' is missing.\n";
1N/A $good = 0;
1N/A }
1N/A }
1N/A print $good ? "ok $N\n" : "not ok $N\n";
1N/A $N++;
1N/A}
1N/A
1N/A# (4) Straight insert and removal FIFO test
1N/A$ar = 'a0';
1N/Afor (1..10) {
1N/A $h->insert($_, $ar++);
1N/A}
1N/Afor (1..10) {
1N/A push @R, $h->popheap;
1N/A}
1N/A$iota = iota('a',9);
1N/Aprint "@R" eq $iota
1N/A ? "ok $N\n" : "not ok $N \# expected ($iota), got (@R)\n";
1N/A$N++;
1N/A
1N/A# (5) Remove from empty heap
1N/A$n = $h->popheap;
1N/Aprint ! defined $n ? "ok $N\n" : "not ok $N \# expected UNDEF, got $n";
1N/A$N++;
1N/A
1N/A# (6) Interleaved insert and removal
1N/A$Q = 0;
1N/A@R = ();
1N/Afor my $i (1..4) {
1N/A for my $j (1..$i) {
1N/A $h->insert($Q, "b$Q");
1N/A $Q++;
1N/A }
1N/A for my $j (1..$i) {
1N/A push @R, $h->popheap;
1N/A }
1N/A}
1N/A$iota = iota('b', 9);
1N/Aprint "@R" eq $iota ? "ok $N\n" : "not ok $N \# expected ($iota), got (@R)\n";
1N/A$N++;
1N/A
1N/A# (7) It should be empty now
1N/Aprint $h->is_empty ? "ok $N\n" : "not ok $N\n";
1N/A$N++;
1N/A
1N/A# (8) Insert and delete
1N/A$Q = 1;
1N/Afor (1..10) {
1N/A $h->insert($_, "c$Q");
1N/A $Q++;
1N/A}
1N/Afor (2, 4, 6, 8, 10) {
1N/A $h->remove($_);
1N/A}
1N/A@R = ();
1N/Apush @R, $n while defined ($n = $h->popheap);
1N/Aprint "@R" eq "c1 c3 c5 c7 c9" ?
1N/A "ok $N\n" : "not ok $N \# expected (c1 c3 c5 c7 c9), got (@R)\n";
1N/A$N++;
1N/A
1N/A# (9) Interleaved insert and delete
1N/A$Q = 1; my $QQ = 1;
1N/A@R = ();
1N/Afor my $i (1..4) {
1N/A for my $j (1..$i) {
1N/A $h->insert($Q, "d$Q");
1N/A $Q++;
1N/A }
1N/A for my $j (1..$i) {
1N/A $h->remove($QQ) if $QQ % 2 == 0;
1N/A $QQ++;
1N/A }
1N/A}
1N/Apush @R, $n while defined ($n = $h->popheap);
1N/Aprint "@R" eq "d1 d3 d5 d7 d9" ?
1N/A "ok $N\n" : "not ok $N \# expected (d1 d3 d5 d7 d9), got (@R)\n";
1N/A$N++;
1N/A
1N/A# (10) Promote
1N/A$Q = 1;
1N/Afor (1..10) {
1N/A $h->insert($_, "e$Q");
1N/A $Q++;
1N/A}
1N/Afor (2, 4, 6, 8, 10) {
1N/A $h->promote($_);
1N/A}
1N/A@R = ();
1N/Apush @R, $n while defined ($n = $h->popheap);
1N/Aprint "@R" eq "e1 e3 e5 e7 e9 e2 e4 e6 e8 e10" ?
1N/A "ok $N\n" :
1N/A "not ok $N \# expected (e1 e3 e5 e7 e9 e2 e4 e6 e8 e10), got (@R)\n";
1N/A$N++;
1N/A
1N/A# (11-15) Lookup
1N/A$Q = 1;
1N/Afor (1..10) {
1N/A $h->insert($_, "f$Q");
1N/A $Q++;
1N/A}
1N/Afor (2, 4, 6, 4, 8) {
1N/A my $r = $h->lookup($_);
1N/A print $r eq "f$_" ? "ok $N\n" : "not ok $N \# expected f$_, got $r\n";
1N/A $N++;
1N/A}
1N/A
1N/A# (16) It shouldn't be empty
1N/Aprint ! $h->is_empty ? "ok $N\n" : "not ok $N\n";
1N/A$N++;
1N/A
1N/A# (17) Lookup should have promoted the looked-up records
1N/A@R = ();
1N/Apush @R, $n while defined ($n = $h->popheap);
1N/Aprint "@R" eq "f1 f3 f5 f7 f9 f10 f2 f6 f4 f8" ?
1N/A "ok $N\n" :
1N/A "not ok $N \# expected (f1 f3 f5 f7 f9 f10 f2 f6 f4 f8), got (@R)\n";
1N/A$N++;
1N/A
1N/A# (18-19) Typical 'rekey' operation
1N/A$Q = 1;
1N/Afor (1..10) {
1N/A $h->insert($_, "g$Q");
1N/A $Q++;
1N/A}
1N/A
1N/A$h->rekey([6,7,8,9,10], [8,9,10,11,12]);
1N/Amy %x = qw(1 g1 2 g2 3 g3 4 g4 5 g5
1N/A 8 g6 9 g7 10 g8 11 g9 12 g10);
1N/A{
1N/A my $good = 1;
1N/A for my $k (keys %x) {
1N/A my $v = $h->lookup($k);
1N/A $v = "UNDEF" unless defined $v;
1N/A unless ($v eq $x{$k}) {
1N/A print "# looked up $k, got $v, expected $x{$k}\n";
1N/A $good = 0;
1N/A }
1N/A }
1N/A print $good ? "ok $N\n" : "not ok $N\n";
1N/A $N++;
1N/A}
1N/A{
1N/A my $good = 1;
1N/A for my $k (6, 7) {
1N/A my $v = $h->lookup($k);
1N/A if (defined $v) {
1N/A print "# looked up $k, got $v, should have been undef\n";
1N/A $good = 0;
1N/A }
1N/A }
1N/A print $good ? "ok $N\n" : "not ok $N\n";
1N/A $N++;
1N/A}
1N/A
1N/A# (20) keys
1N/A@R = sort { $a <=> $b } $h->keys;
1N/Aprint "@R" eq "1 2 3 4 5 8 9 10 11 12" ?
1N/A "ok $N\n" :
1N/A "not ok $N \# expected (1 2 3 4 5 8 9 10 11 12) got (@R)\n";
1N/A$N++;
1N/A
1N/A# (21) update
1N/Afor (1..5, 8..12) {
1N/A $h->update($_, "h$_");
1N/A}
1N/A@R = ();
1N/Afor (sort { $a <=> $b } $h->keys) {
1N/A push @R, $h->lookup($_);
1N/A}
1N/Aprint "@R" eq "h1 h2 h3 h4 h5 h8 h9 h10 h11 h12" ?
1N/A "ok $N\n" :
1N/A "not ok $N \# expected (h1 h2 h3 h4 h5 h8 h9 h10 h11 h12) got (@R)\n";
1N/A$N++;
1N/A
1N/A# (22-23) bytes
1N/Amy $B;
1N/A$B = $h->bytes;
1N/Aprint $B == 23 ? "ok $N\n" : "not ok $N \# expected 23, got $B\n";
1N/A$N++;
1N/A$h->update('12', "yobgorgle");
1N/A$B = $h->bytes;
1N/Aprint $B == 29 ? "ok $N\n" : "not ok $N \# expected 29, got $B\n";
1N/A$N++;
1N/A
1N/A# (24-25) empty
1N/A$h->empty;
1N/Aprint $h->is_empty ? "ok $N\n" : "not ok $N\n";
1N/A$N++;
1N/A$n = $h->popheap;
1N/Aprint ! defined $n ? "ok $N\n" : "not ok $N \# expected UNDEF, got $n";
1N/A$N++;
1N/A
1N/A# (26) very weak testing of DESTROY
1N/Aundef $h;
1N/A# are we still alive?
1N/Aprint "ok $N\n";
1N/A$N++;
1N/A
1N/A
1N/Asub iota {
1N/A my ($p, $n) = @_;
1N/A my $r;
1N/A my $i = 0;
1N/A while ($i <= $n) {
1N/A $r .= "$p$i ";
1N/A $i++;
1N/A }
1N/A chop $r;
1N/A $r;
1N/A}