Skip Menu |

This queue is for tickets about the Parse-Eyapp CPAN distribution.

Report information
The Basics
Id: 38685
Status: resolved
Priority: 0/
Queue: Parse-Eyapp

People
Owner: Nobody in particular
Requestors: half [...] halssoftware.com
Cc:
AdminCc:

Bug Information
Severity: Important
Broken in: 1.111
Fixed in: (no value)



Subject: Tree alias accessors not created properly
Accessors created using the tree alias feature are not always correct in the current version. This is because: 1. The $semantic hash reference is not updated upon rule creation to record non-terminals an semantic. 2. The child index is calculated incorrectly is not all semantic children are named. I believe the attached patch fixes both of these issues and adds a test. Also (not fixed by the attached patch), there should be a way to specify a prefix for the accessors so that they can work with a tree built with a specified yyprefix.
Subject: Parse-Eyapp-1.111-accessors_fix.diff
diff -ruN Parse-Eyapp-1.111.orig/lib/Parse/Eyapp/Parse.pm Parse-Eyapp-1.111/lib/Parse/Eyapp/Parse.pm --- Parse-Eyapp-1.111.orig/lib/Parse/Eyapp/Parse.pm 2008-06-26 08:50:51.000000000 -0400 +++ Parse-Eyapp-1.111/lib/Parse/Eyapp/Parse.pm 2008-08-23 11:18:44.000000000 -0400 @@ -120,8 +120,8 @@ my ($symb, $line, $id) = @{$value->[1]}; # Accessors will be build only for explictly named attributes - next unless defined($id) and $$semantic{$symb}; - $index{$id} = $_; + next unless $$semantic{$symb}; + $index{$id} = $_ if defined($id); $_++ ; } @@ -2046,6 +2046,7 @@ delete($$term{$lhs}); #No more a terminal }; $$nterm{$lhs}=[]; #It's a non-terminal now + $$semantic{$lhs} = 1; my($epsrules)=0; #To issue a warning if more than one epsilon rule diff -ruN Parse-Eyapp-1.111.orig/lib/Parse/Eyapp/Parse.yp Parse-Eyapp-1.111/lib/Parse/Eyapp/Parse.yp --- Parse-Eyapp-1.111.orig/lib/Parse/Eyapp/Parse.yp 2008-04-12 05:26:39.000000000 -0400 +++ Parse-Eyapp-1.111/lib/Parse/Eyapp/Parse.yp 2008-08-23 11:16:24.000000000 -0400 @@ -96,8 +96,8 @@ my ($symb, $line, $id) = @{$value->[1]}; # Accessors will be build only for explictly named attributes - next unless defined($id) and $$semantic{$symb}; - $index{$id} = $_; + next unless $$semantic{$symb}; + $index{$id} = $_ if defined($id); $_++ ; } @@ -938,6 +938,7 @@ delete($$term{$lhs}); #No more a terminal }; $$nterm{$lhs}=[]; #It's a non-terminal now + $$semantic{$lhs} = 1; my($epsrules)=0; #To issue a warning if more than one epsilon rule diff -ruN Parse-Eyapp-1.111.orig/t/51accessors.t Parse-Eyapp-1.111/t/51accessors.t --- Parse-Eyapp-1.111.orig/t/51accessors.t 1969-12-31 19:00:00.000000000 -0500 +++ Parse-Eyapp-1.111/t/51accessors.t 2008-08-23 11:06:57.000000000 -0400 @@ -0,0 +1,88 @@ +#!/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 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} = <STDIN> + 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'); +
Thank you Hal, Version 1.112 incorporates the patch. Show quoted text
> Also (not fixed by the attached patch), there should be a way to specify > a prefix for the accessors so that they can work with a tree built with > a specified yyprefix. >
As soon as I find time I will try to work on this (but it will not be until October 2008) Thanks again Casiano
RT-Send-CC: casiano [...] ull.es
Dear Hal, This requirement Show quoted text
> Also (not fixed by the attached patch), there should > be a way to specify > a prefix for the accessors > so that they can work with a tree built with > a specified yyprefix. >
seems to be fixed in version 1.118. See the two enclosed tests (t/54alias_and_yyprefix.t and t/60dynamicyyprefix_and_alias.t). Many thanks for your fixes and suggestions. Let me know if you need anything else Best wishes Casiano
#!/usr/bin/perl -w use strict; use Test::More tests=>8; use_ok qw(Parse::Eyapp) or exit; use Data::Dumper; my $grammar = q{ %prefix R::S:: %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(); $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
#!/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