#!/usr/bin/perl -w use strict; use Test::More tests=>3; use_ok qw(Parse::Eyapp) or exit; my $grammar = q{ %right '=' %left '-' '+' %left '*' '/' %left NEG %tree bypass alias %% line: exp { $_[1] } ; like_prefix: %name like_prefix LIKE VAR.var ':' | %name like_prefix_null ; exp: %name NUM NUM { $_[1] } | %name VAR VAR { $_[1] } | %name ASSIGN like_prefix.like VAR.var '=' exp.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 | %name UMINUS '-' exp.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} = or return('',undef); $parser->YYData->{INPUT}=~s/^\s+//; for ($parser->YYData->{INPUT}) { s/^([0-9]+(?:\.[0-9]+)?)// and return('NUM',$1); s/^(like)//i and return(uc($1),uc($1)); s/^([A-Za-z][A-Za-z0-9_]*)// and return('VAR',$1); s/^(.)//s and return($1,$1); } } sub parse { my $p = shift; return $p->YYParse( yylex => \&_Lexer, yyerror => \&_Error, yydebug => 0x0 ); } }; # end grammar Parse::Eyapp->new_grammar(input=>$grammar, classname=>'Calc'); my $p = Calc->new(); $p->YYData->{INPUT} = "like x: y = 2\n"; my $result = $p->parse(); ok($result->can('like'), 'accessor created'); is(eval { $result->like()->var()->{'attr'} }, 'x', 'accessors ok');