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