#!/usr/bin/perl -w
use strict;
use Test::More tests=>8;
use_ok qw(Parse::Eyapp) or exit;
use Data::Dumper;
my $grammar = q{
%right '='
%left '-' '+'
%left '*' '/'
%left NEG
%tree bypass alias
%%
line: $exp { $_[1] }
;
exp:
%name NUM
$NUM
| %name VAR
$VAR
| %name ASSIGN
$VAR '=' $exp
| %name PLUS
exp.left '+' exp.right
| %name MINUS
exp.left '-' exp.right
| %name TIMES
exp.left '*' exp.right
| %name DIV
exp.left '/' exp.right
| %no bypass UMINUS
'-' $exp %prec NEG
| '(' exp ')' { $_[2] } /* Let us simplify a bit the tree */
;
%%
sub _Error {
exists $_[0]->YYData->{ERRMSG}
and do {
print $_[0]->YYData->{ERRMSG};
delete $_[0]->YYData->{ERRMSG};
return;
};
print "Syntax error.\n";
}
sub _Lexer {
my($parser)=shift;
$parser->YYData->{INPUT}
or $parser->YYData->{INPUT} = <STDIN>
or return('',undef);
$parser->YYData->{INPUT}=~s/^\s+//;
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);
}
}
sub Run {
my($self)=shift;
$self->YYParse( yylex => \&_Lexer, yyerror => \&_Error,
#yydebug =>0xFF
);
}
}; # end grammar
Parse::Eyapp->new_grammar(
input=>$grammar,
classname=>'Alias',
#firstline =>7,
outputfile => 'main',
);
my $parser = Alias->new( yyprefix => 'R::S::');
$parser->YYData->{INPUT} = "a = -(2*3+5-1)\n";
my $t = $parser->Run;
can_ok('R::S::ASSIGN', 'VAR', 'exp');
can_ok('R::S::PLUS', 'left', 'right');
can_ok('R::S::MINUS', 'left', 'right');
can_ok('R::S::TIMES', 'left', 'right');
can_ok('R::S::DIV', 'left', 'right');
is($t->VAR->attr, 'a', 'alias accessor ok');
# $t is
# R::S::ASSIGN(
# R::S::TERMINAL,
# R::S::UMINUS(
# R::S::MINUS(
# R::S::PLUS(R::S::TIMES(R::S::NUM,R::S::NUM),R::S::NUM),
# R::S::NUM)))
my $expected = bless( {
'children' => [
bless( {
'children' => [
bless( {
'children' => [],
'attr' => '2',
'token' => 'NUM'
}, 'R::S::NUM' ),
bless( {
'children' => [],
'attr' => '3',
'token' => 'NUM'
}, 'R::S::NUM' )
]
}, 'R::S::TIMES' ),
bless( {
'children' => [],
'attr' => '5',
'token' => 'NUM'
}, 'R::S::NUM' )
]
}, 'R::S::PLUS' );
is_deeply($t->exp->exp->left, $expected, 'alias accessor ok');
#print $t->exp->exp->right->str."\n"; # 1