1# Before `make install' is performed this script should be runnable with 2# `make test'. After `make install' it should work as `perl test.pl' 3 4BEGIN { 5 chdir 't' if -d 't'; 6 use lib '../lib'; 7 $| = 1; 8 print "1..7\n"; 9} 10use Heap; 11use Heap::Elem::NumRev; 12 13my @test_seq = 14 ( 15 [ test_empty => ], 16 [ add => 1, 100 ], 17 [ test => 100 ], 18 [ remove => 50, 100, 51 ], 19 [ test => 50 ], 20 [ remove => 50, 50, 1 ], 21 [ test_empty => ], 22 [ repeat => 0, 2 ], 23 [ mem_test => ], 24 [ repeat => 1, 50 ], 25 [ last => ], 26 ); 27my $test_index = 0; 28my @repeat_count = ( 0, 0, 0, 0 ); 29 30my $heap = new Heap::Fibonacci; 31my $test_num = 0; 32my $still_testing = 1; 33my $not; 34 35while (1) { 36 my $step = $test_seq[$test_index++]; 37 my $op = $step->[0]; 38 my $scratch; 39 $not = 'not '; 40 if( $op eq 'test_empty' ) { 41 defined($heap->top) or $not = ''; 42 } elsif( $op eq 'test' ) { 43 defined($scratch = $heap->top) and $scratch->val == $step->[1] and $not = ''; 44 } elsif( $op eq 'add' ) { 45 my( $base, $limit, $incr ) = (@$step)[1..3]; 46 defined $incr or $incr = 1; 47 while(1) { 48 my $elem = new Heap::Elem::NumRev($base); 49 $heap->add( $elem ); 50 last if $base == $limit; 51 $base += $incr; 52 } 53 $not = 'skip'; 54 } elsif( $op eq 'remove' ) { 55 my( $count, $base, $limit, $incr ) = (@$step)[1..4]; 56 defined $incr or $incr = -1; 57 $not = ''; 58 while($count--) { 59 my $elem = $heap->extract_top; 60 defined($elem) && $elem->val == $base 61 or $not = 'not '; 62 $base += $incr; 63 } 64 $not = 'not ' 65 if $base != $limit + $incr; 66 } elsif( $op eq 'repeat' ) { 67 my( $index, $limit ) = (@$step)[1..2]; 68 if( $still_testing ) { 69 $still_testing = 0; 70 } 71 if( ++$repeat_count[$index] == $limit ) { 72 $repeat_count[$index] = 0; 73 } else { 74 $test_index = 0; 75 } 76 $not = ''; 77 } elsif( $op eq 'mem_test' ) { 78 $not = ''; 79 print `ps -lp$$`; 80 } elsif( $op eq 'last' ) { 81 $not = ''; 82 last; 83 } 84 if( $not ne 'skip' ) { 85 if( $still_testing ) { 86 ++$test_num; 87 print $not, "ok $test_num\n"; 88 } else { 89 last if $not; 90 } 91 } 92} 93 94++$test_num; 95print $not, "ok $test_num\n"; 96