package Test_Framework;

use warnings;
use strict;
use Exporter;
use vars qw(@ISA @EXPORT);

@ISA = qw(Exporter);
@EXPORT = qw(&Test &Test_Failure &Report_Results &Arrays_Equal);
my $test_no = 1;
my @results;

sub Test(&) {
    my $code = $_[0];
    push @results, test_succeeds($code);
    if ( ! $results[$#results] ) {
	print STDERR $@, "\n" if $@;
    }
}

sub Test_Failure(&) {
    my $code = $_[0];
    push @results, ! test_succeeds($code);
}

sub Report_Results() {
    print '1..', ($#results+1), "\n";
    for ( my $i = 0; $i <= $#results; $i++ ) {
	print $results[$i] ? 'ok' : 'not ok', ' ', $i+1, "\n";
    }
}

sub test_succeeds {
    my $code = $_[0];
    my $result;
    eval { $result = &$code };
    return $result && ! $@;
}

sub Arrays_Equal($$) {
    my ($a1, $a2) = @_;
    return 0 if $#$a1 != $#$a2;
    for ( my $i = 0; $i <= $#$a1; $i++ ) {
	return 0 if $$a1[$i] ne $$a2[$i];
    }
    return 1;
}

1;