$^W=0;

# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'

######################### We start with some black magic to print on failure.

# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)

BEGIN { $| = 1; print "1..15\n"; }
END {print "not ok 1\n" unless $loaded;}
use Parse::Yapp;
$loaded = 1;
print "ok 1\n";

######################### End of black magic.

# Insert your test code below (better if it prints "ok 13"
# (correspondingly "not ok 13") depending on the success of chunk 13
# of the test code):

use Parse::Yapp;

my($testnum)=2;
my($parser,$grammar);
my($yapptxt);

#Test 2
eval  {
	$grammar=join('',<DATA>);
	$parser=new Parse::Yapp(input => $grammar);
};

	$@
and	do {
	print "not ok $testnum\n";
	print "Object not created. Cannot continue test suite: aborting\n";
	exit(1);
};
print "ok $testnum\n";
++$testnum;

#Test 3
eval {
	$yapptxt=$parser->Output(classname => 'Calc');
};
	$@
and	do {
	print "not ok $testnum\n";
	print "Parser not generated. Cannot continue test suite: aborting\n";
	exit(1);
};
print "ok $testnum\n";
++$testnum;

#Test 4
eval $yapptxt;
	$@
and	do {
	print "not ok $testnum\n";
	print "Parser not loaded. Cannot continue test suite: aborting\n";
	exit(1);
};
print "ok $testnum\n";
++$testnum;

#Test 5
my($calc);
eval {
	$calc=new Calc();
};
	$@
and	do {
	print "not ok $testnum\n";
	print "Parser not found. Cannot continue test suite: aborting\n";
	exit(1);
};
print "ok $testnum\n";
++$testnum;

#Test 6
eval {
	$calc->YYData->{INPUT}="13*2\n-(13*2)+3\n5^3+2\n";
	@outcheck=((13*2),(-(13*2)+3),(5**3+2));
	$output=$calc->YYParse(yylex => \&Calc::Lexer);
};
print $@ ? "not ok $testnum\n" : "ok $testnum\n";
++$testnum;

#Test 7
print       join(',',@$output) ne join(',',@outcheck)
        ?   "not ok $testnum\n"
        :   "ok $testnum\n";
++$testnum;

#Test 8
eval {
    delete($calc->YYData->{LINE});
	$calc->YYData->{INPUT}="5+8\n-(13*2)+3--\n3*8\n**7-3(12*55)\n12*(5-2)\n";
	@outcheck=((5+8), undef, (3*8), undef, (12*(5-2)));
    @errcheck=( 2, 4);
    $nberr=2;
	$output=$calc->YYParse(yylex => \&Calc::Lexer, yyerror => \&Calc::Error);
};
print $@ ? "not ok $testnum\n" : "ok $testnum\n";
++$testnum;

#Test 9
print       join(',',@$output) ne join(',',@outcheck)
        ?   "not ok $testnum\n"
        :   "ok $testnum\n";
++$testnum;

#Test 10
print       join(',',@{$calc->YYData->{ERRLINES}}) ne join(',',@errcheck)
        ?   "not ok $testnum\n"
        :   "ok $testnum\n";
++$testnum;

#Test 11
print       $calc->YYNberr != $nberr 
        ?   "not ok $testnum\n"
        :   "ok $testnum\n";
++$testnum;

#Test 12
eval {
	$calc->YYData->{INPUT}="a=-(13*2)+3\nb=12*(5-2)\na*b\n";
	@outcheck=((-(13*2)+3), (12*(5-2)), ((-(13*2)+3)*(12*(5-2))));
			  
	$output=$calc->YYParse(yylex => \&Calc::Lexer, yyerror => \&Calc::Error);
};
print $@ ? "not ok $testnum\n" : "ok $testnum\n";
++$testnum;

#Test 13 
print       join(',',@$output) ne join(',',@outcheck)
        ?   "not ok $testnum\n"
        :   "ok $testnum\n";
++$testnum;

#Test 14
eval {

	local *STDERR;

	close(STDERR);	#Supress debug output

	$calc->YYData->{INPUT}="a=-(13*2)+3\n-*12\nb=12*(5-2)\na*b\n";
	@outcheck=((-(13*2)+3), undef, (12*(5-2)), ((-(13*2)+3)*(12*(5-2))));
			  
	$output=$calc->YYParse(yylex => \&Calc::Lexer,
						 yyerror => \&Calc::Error,
						 yydebug => 0xFF );
};
print $@ ? "not ok $testnum\n" : "ok $testnum\n";
++$testnum;

#Test 15 
print       join(',',@$output) ne join(',',@outcheck)
        ?   "not ok $testnum\n"
        :   "ok $testnum\n";
++$testnum;

__DATA__

%right  '='
%left   '-' '+'
%left   '*' '/'
%left   NEG
%right  '^'

%%
input:  #empty
        |   input line  { push(@{$_[1]},$_[2]); $_[1] }
;

line:       '\n'                { ++$_[0]->YYData->{LINE}; $_[1] }
        |   exp '\n'            { ++$_[0]->YYData->{LINE}; $_[1] }
		|	error '\n'  { ++$_[0]->YYData->{LINE}; $_[0]->YYErrok }
;

exp:        NUM
        |   VAR                 { $_[0]->YYData->{VARS}{$_[1]} }
        |   VAR '=' exp         { $_[0]->YYData->{VARS}{$_[1]}=$_[3] }
        |   exp '+' exp         { $_[1] + $_[3] }
        |   exp '-' exp         { $_[1] - $_[3] }
        |   exp '*' exp         { $_[1] * $_[3] }
        |   exp '/' exp         { $_[1] / $_[3] }
        |   '-' exp %prec NEG   { -$_[2] }
        |   exp '^' exp         { $_[1] ** $_[3] }
        |   '(' exp ')'         { $_[2] }
;

%%

sub Error {
    my($parser)=shift;

	push(@{$parser->YYData->{ERRLINES}}, $parser->YYData->{LINE});
}

sub Lexer {
    my($parser)=shift;

        exists($parser->YYData->{LINE})
    or  $parser->YYData->{LINE}=1;

        $parser->YYData->{INPUT}
    or  return('',undef);

    $parser->YYData->{INPUT}=~s/^[ \t]//;

    for ($parser->YYData->{INPUT}) {
        s/^([0-9]+(?:\.[0-9]+)?)//
                and return('NUM',$1);
        s/^([A-Za-z][A-Za-z0-9_]*)//
                and return('VAR',$1);
        s/^(.)//s
                and return($1,$1);
    }
}