#!/usr/bin/perl -w # This test shows that using the method Parse::Eyapp::Node::delete we can achieve # the node self destruction even if its'nt a node! # Furthermore we use treeregexp use strict; use Test::More tests => 3; use_ok qw( Parse::Eyapp ); #use Parse::Eyapp; use_ok qw( Parse::Eyapp::Treeregexp ); #use Parse::Eyapp::Treeregexp; # use Data::Dumper; my $debug = 0; my $translationscheme = q{ %{ # head code is available at tree construction time # #use Data::Dumper; %} %defaultaction { $lhs->{n} = $_[1]->{n} } %metatree %left '-' '+' %left '*' %left NEG %% line: %name EXP exp ; exp: %name PLUS exp.left '+' exp.right { $lhs->{n} .= $left->{n} + $right->{n} } | %name TIMES exp.left '*' exp.right { $lhs->{n} = $left->{n} * $right->{n} } | %name NUM $NUM { $lhs->{n} = $NUM->{attr} } | '(' $exp ')' %begin { $exp } | %name MINUS exp.left '-' exp.right { $lhs->{n} = $left->{n} - $right->{n} } | %name UMINUS '-' $exp %prec NEG { $lhs->{n} = -$exp->{n} } ; %% # tail code is available at tree construction time sub _Error { die "Syntax error.\n"; } sub _Lexer { my($parser)=shift; $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/^([A-Za-z][A-Za-z0-9_]*)// and return('VAR',$1); s/^(.)// and return($1,$1); s/^\s*//; } } sub Run { my($self)=shift; return $self->YYParse( yylex => \&_Lexer, yyerror => \&_Error ); } }; # end translation scheme sub show_match { my $self = shift; print "Index: $_[1]\n"; # print "node:\n",Dumper($self); # print "Father:\n",Dumper($_[0]); } my $transform = Parse::Eyapp::Treeregexp->new( STRING => q{ delete_code : CODE => { $delete_code->delete() } { sub not_semantic { my $self = shift; return 1 if ((ref($self) eq 'TERMINAL') and ($self->{token} eq $self->{attr})); return 0; } } delete_tokens : TERMINAL and { not_semantic($TERMINAL) } => { $delete_tokens->delete(); } insert_child : NUM(TERMINAL) => { my $b = Parse::Eyapp::Node->new( 'NUM(TERMINAL)', sub { $_[1]->{attr} = 4+$TERMINAL->{attr} }); $insert_child->unshift($b); } }, #OUTPUTFILE => 'main.pm' )->generate(); Parse::Eyapp->new_grammar( input=>$translationscheme, classname=>'Calc', firstline =>7, #outputfile => 'Calc.pm' ); my $parser = Calc->new(); # Create the parser $parser->YYData->{INPUT} = "2*3\n"; # Set the input my $t = $parser->Run; # Parse it # $Data::Dumper::Indent = 1; # $Data::Dumper::Terse = 1; # $Data::Dumper::Deepcopy = 1; # print Dumper($t); # Show the tree # Get the AST our ($delete_tokens, $delete_code); $t->s($delete_tokens, $delete_code); our $insert_child; $insert_child->s($t); # print Dumper($t); # Show the tree my $expectedtree = bless( { 'children' => [ bless( { 'children' => [ bless( { 'children' => [ bless( { 'children' => [], 'attr' => 7 }, 'TERMINAL' ) ] }, 'NUM' ), bless( { 'children' => [ bless( { 'children' => [], 'attr' => 6 }, 'TERMINAL' ) ] }, 'NUM' ), bless( { 'children' => [ bless( { 'children' => [], 'attr' => 2, 'token' => 'NUM' }, 'TERMINAL' ) ] }, 'NUM' ), bless( { 'children' => [ bless( { 'children' => [], 'attr' => 3, 'token' => 'NUM' }, 'TERMINAL' ) ] }, 'NUM' ) ] }, 'TIMES' ) ] }, 'EXP' ); is_deeply($t, $expectedtree, "unshifting two nodes in myself");