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');
+