use ReDIF::Parser::Input;

require 't/pinput.parsed';

my @extract_results;

use vars qw( @GOOD_input_events @GOOD_extract_results );


&ReDIF::Parser::Input::init( { attribute_output => 'TEST' } );

$r = ReDIF::Parser::Input::start_file( 't/pinput.data', 0 );

while( defined $r ) {
    $r = &ReDIF::Parser::Input::extract_next_attribute();
    push @extract_results, $r;
}

$r = ReDIF::Parser::Input::extract_next_attribute();
push @extract_results, $r;
$r = ReDIF::Parser::Input::extract_next_attribute();
push @extract_results, $r;

my $result_events = \@TEST::EVENTS;
my $good_events = \@GOOD_input_events;
my $good_extract_results = \@GOOD_extract_results;

my $c = 0;
foreach my $ev ( @$result_events ) {

    my $fail = 0;
    my $gev = $good_events->[$c];

    my $i;
    for ( $i = 0; $i <= $#$ev ; $i++ ) {
	print "happened: $ev->[$i]\n";
	print "expected: $gev->[$i]\n";
	if( $ev->[$i] eq $gev->[$i] ) {
	    test( 1 );
	} else {
	    test( 0, $ev->[$i] );
	    $fail = 1;
	}
    }

#    if( $fail ) {
#	print "was  $c: >>>", join ( ', ', @$ev ), "<<<\n"; 
#	print "good $c: ==>", join ( ', ', @$gev ), "<==\n"; 
#    }
    
    $c++;
}


while( $c < $#$good_events ) {
    my $gev = $good_events->[$c];
    print "was  $c: nothing\n";
    print "good $c: ==>", join ( ', ', @$gev ), "<==\n"; 
    test( 0 );
    $c++;
}


test( $c );

$c = 0;
while( 1 ) {

    my $fail;
    if( defined $good_extract_results->[$c] ) {
	if( $extract_results[$c] ) {
	    if( $good_extract_results->[$c] ) { $fail = 0; }
	    else { $fail = 1; }
	} else { 
	    if( not $good_extract_results->[$c] ) { $fail = 0; }
	    else { $fail = 1; }
	}
    }		 

    if( $fail ) {
	print "extract call $c: was >>>" ,  $extract_results[$c] , "<<<",
              ", good: >>>" , $good_extract_results->[$c] , "<<<\n";
	test( 0 );
    } else { 
	test( 1 );
    }

    $c++;

    if ( not defined $extract_results[$c] 
	 and not defined $good_extract_results->[$c] ) {
	last;
    }

}



###################    TEST   PACKAGE   ######################

{ 
    package TEST;
    use strict;
    use vars qw( @EVENTS );
    
    sub the_attribute {
	my $self = shift;
	my @args = @_;
	my $event = [ 'the_attribute', @args ];
	push @EVENTS, $event;
    }


    sub close_current_template {
        my $self = shift;
	my @args = @_;
	my $event = [ 'close_current_template', @args ];
	push @EVENTS, $event;
    }

}




###############################################################
#############     TESTING   FRAMEWORK     #####################
###############################################################

sub test {
    push @TESTS, shift;
    push @MESSAGES, shift;
}

sub ok { 
    push @TESTS, 1; 
    push @MESSAGES, shift;
}
sub nok { 
    push @TESTS, 0; 
    push @MESSAGES, shift;
}



END { 

    my $tests = scalar @TESTS;

    if( not $tests ) {
	print "1..1\nnot ok 1\n";
	exit;
    }

    print "1..$tests\n";

    my $counter = 1;
    while ( 1 ) {
	my $t = shift @TESTS;
	my $m = shift @MESSAGES;
	if( not $t ) {
	    print "not ";
	}
	print "ok $counter\n";

	if( $m ) { 
	    print "[$counter] $m\n";
	}
	last if not scalar @TESTS;
	$counter ++;
    }
}
