$DEBUG=0;
$|=1;

@tests=(
  [ #1  Basic test
<<'EOT'
%{ my $out; %}
%%
S:  A { return($out) } ;
A:  'a' 'b' 'c' D { $out=$_[1].$_[2].$_[3].$_[4]; undef } ;
D:  'd' ;
%%
EOT
, [ 'a','b','c','d' ], "abcd"
],[ #2  In rule actions
<<'EOT'
%{ my $out; %}
%%
S:  A { return($out) } ;
A:  'a' { $out=$_[1] } 'b' { $out.=$_[3]} 'c' { $out.=$_[5]}
    D { $out.=$_[7].$_[5].$_[3].$_[1] } ;
D:  'd' ;
%%
EOT
, [ 'a', 'b', 'c', 'd' ], "abcdcba"
],[ #3  YYSemval > 0
<<'EOT'
%{ my $out; %}
%%
S:  A { return($out) } ;
A:  'a' 'b' 'c' D { $out.=$_[0]->YYSemval(1).
                          $_[0]->YYSemval(2).
                          $_[0]->YYSemval(3).
                          $_[0]->YYSemval(4);
                    undef
                  }
;
D:  'd' ;
%%
EOT
, [ 'a', 'b', 'c', 'd' ], "abcd"
],[ #4  YYSemval < 0
<<'EOT'
%{ my $out; %}
%%
S:  A { return($out) } ;
A:  'a' 'b' X ;
X:  'c' 'd' { $out=$_[0]->YYSemval(-1).$_[0]->YYSemval(0).$_[1].$_[2] };
%%
EOT
, [ 'a', 'b', 'c', 'd' ], "abcd"
],[ #5  Left assoc
<<'EOT'
%{ my $out; %}
%left '*'
%%
S:  A { return($out) } ;
A:  A '*' A { $out="($_[1]$_[2]$_[3])" }
  | B
;
B:  'a' | 'b' | 'c' | 'd' ;
%%
EOT
, [ 'a', '*', 'b', '*', 'c', '*', 'd' ], "(((a*b)*c)*d)"
],[ #6  Right assoc
<<'EOT'
%{ my $out; %}
%right '*'
%%
S:  A { return($out) } ;
A:  A '*' A { $out="($_[1]$_[2]$_[3])" }
  | B
;
B:  'a' | 'b' | 'c' | 'd' ;
%%
EOT
, [ 'a', '*', 'b', '*', 'c', '*', 'd' ], "(a*(b*(c*d)))"
],
[ #7 nonassoc
<<'EOT'
%{ my $out; %}
%nonassoc '+'
#%left '+'
%%
S:      S '+' S { $out }
    |   'a'
    |   error { $out="nonassoc" }
    ;
%%
EOT
, [ 'a' , '+', 'a', '+', 'a' ], "nonassoc"
],
[ #8  Left assoc with '\\'
<<'EOT'
%{ my $out; %}
%left '\\'
%%
S:  A { return($out) } ;
A:  A '\\' A { $out="($_[1]$_[2]$_[3])" }
  | B
;
B:  'a' | 'b' | 'c' | 'd' ;
%%
EOT
, [ 'a', '\\', 'b', '\\', 'c', '\\', 'd' ], '(((a\b)\c)\d)'
],
);

use Parse::Yapp;

my($count)=0;

sub TestIt {
    my($g,$in,$chk)=@_;

    my($lex) = sub {
        my($t)=shift(@$in);

            defined($t)
        or  $t='';
        return($t,$t);
    };

    ++$count;

    my($p)=new Parse::Yapp(input => $g);
    $p=$p->Output(classname => 'Test');

        $DEBUG
    and print $p;

    eval $p;
        $@
    and do {
        print "$@\n";
        print "not ok $count\n";
        return;
    };

    $p=new Test(yylex => $lex, yyerror => sub {});

    $out=$p->YYParse;
    undef $p;

        $out eq $chk
    or  do {
        print "Got '$out' instead of '$chk'\n";
        print 'not ';
    };
    print 'ok'," $count\n";
    undef(&Test::new);
}

print '1..'.@tests."\n";

for (@tests) {
    TestIt(@$_);
}