r42957 - in /trunk/libparse-recdescent-perl: Changes META.yml README debian/changelog debian/control demo/demo_calc.pl lib/Parse/RecDescent.pm
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Wed Aug 26 20:20:11 UTC 2009
Author: jawnsy-guest
Date: Wed Aug 26 20:19:58 2009
New Revision: 42957
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=42957
Log:
* New upstream release
+ Fix asymmetrical push/pop on @lines tracker
+ Remove occurrences of $& so we don't affect other regexes
* Standards-Version 3.8.3 (no changes)
* Prepare to shift to new debhelper rules format
* Depend on either perl-modules >= 5.10 OR libversion-perl
Modified:
trunk/libparse-recdescent-perl/Changes
trunk/libparse-recdescent-perl/META.yml
trunk/libparse-recdescent-perl/README
trunk/libparse-recdescent-perl/debian/changelog
trunk/libparse-recdescent-perl/debian/control
trunk/libparse-recdescent-perl/demo/demo_calc.pl
trunk/libparse-recdescent-perl/lib/Parse/RecDescent.pm
Modified: trunk/libparse-recdescent-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libparse-recdescent-perl/Changes?rev=42957&op=diff
==============================================================================
--- trunk/libparse-recdescent-perl/Changes (original)
+++ trunk/libparse-recdescent-perl/Changes Wed Aug 26 20:19:58 2009
@@ -553,3 +553,16 @@
- Added: <warn> <hint> <trace_build> <trace_parse> <nocheck>
-
+
+
+1.962.0 Tue Aug 25 19:45:15 2009
+
+ - Doc bug fix (thanks Christophe)
+
+ - Fixed assymmetrical push/pop on @lines tracker (thanks Peter!)
+
+ - Bumped sub-version number hugely to fix CPAN indexing (thanks Jerome)
+
+ - Remove all occurrences of $& so we don't affect other regular expressions.
+
+ - Perl 5.6.0 required for use of $+[0] and $-[0] for replacement of $&.
Modified: trunk/libparse-recdescent-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libparse-recdescent-perl/META.yml?rev=42957&op=diff
==============================================================================
--- trunk/libparse-recdescent-perl/META.yml (original)
+++ trunk/libparse-recdescent-perl/META.yml Wed Aug 26 20:19:58 2009
@@ -1,13 +1,16 @@
-# http://module-build.sourceforge.net/META-spec.html
-#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
-name: Parse-RecDescent
-version: 1.96.0
-version_from: lib/Parse/RecDescent.pm
-installdirs: site
-requires:
+--- #YAML:1.0
+name: Parse-RecDescent
+version: 1.962.0
+abstract: Generate Recursive-Descent Parsers
+license: ~
+author:
+ - Damian Conway <DCONWAY at CPAN.org>
+generated_by: ExtUtils::MakeMaker version 6.42
+distribution_type: module
+requires:
Test::More: 0
Text::Balanced: 0
version: 0
-
-distribution_type: module
-generated_by: ExtUtils::MakeMaker version 6.30
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.3.html
+ version: 1.3
Modified: trunk/libparse-recdescent-perl/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libparse-recdescent-perl/README?rev=42957&op=diff
==============================================================================
--- trunk/libparse-recdescent-perl/README (original)
+++ trunk/libparse-recdescent-perl/README Wed Aug 26 20:19:58 2009
@@ -1,4 +1,4 @@
-Parse::RecDescent version 1.96.0
+Parse::RecDescent version 1.962.0
NAME
Modified: trunk/libparse-recdescent-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libparse-recdescent-perl/debian/changelog?rev=42957&op=diff
==============================================================================
--- trunk/libparse-recdescent-perl/debian/changelog (original)
+++ trunk/libparse-recdescent-perl/debian/changelog Wed Aug 26 20:19:58 2009
@@ -1,10 +1,16 @@
-libparse-recdescent-perl (1.96.0+dfsg-4) UNRELEASED; urgency=low
-
+libparse-recdescent-perl (1.962.0+dfsg-1) UNRELEASED; urgency=low
+
+ * New upstream release
+ + Fix asymmetrical push/pop on @lines tracker
+ + Remove occurrences of $& so we don't affect other regexes
* d/control: change maintainer, add /me to Uploaders (Closes: #534358)
* Change Vcs field to our repository/viewer
* Change watch to a dist-based rather than author-based one
-
- -- Jonathan Yu <frequency at cpan.org> Tue, 23 Jun 2009 19:11:37 -0400
+ * Standards-Version 3.8.3 (no changes)
+ * Prepare to shift to new debhelper rules format
+ * Depend on either perl-modules >= 5.10 OR libversion-perl
+
+ -- Jonathan Yu <frequency at cpan.org> Wed, 26 Aug 2009 12:14:38 -0400
libparse-recdescent-perl (1.96.0+dfsg-3) unstable; urgency=low
Modified: trunk/libparse-recdescent-perl/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libparse-recdescent-perl/debian/control?rev=42957&op=diff
==============================================================================
--- trunk/libparse-recdescent-perl/debian/control (original)
+++ trunk/libparse-recdescent-perl/debian/control Wed Aug 26 20:19:58 2009
@@ -1,29 +1,30 @@
Source: libparse-recdescent-perl
Section: perl
Priority: optional
+Build-Depends: debhelper (>= 7.0.8), quilt (>= 0.46-7)
+Build-Depends-Indep: perl-modules (>= 5.10) | libversion-perl, libtest-pod-perl
Maintainer: Debian Perl Group <pkg-perl-maintainers at lists.alioth.debian.org>
Uploaders: Jonathan Yu <frequency at cpan.org>
-Standards-Version: 3.8.1
-Build-Depends: debhelper (>= 7.0.0), quilt
-Build-Depends-Indep: libtest-pod-perl, libversion-perl
+Standards-Version: 3.8.3
Homepage: http://search.cpan.org/dist/Parse-RecDescent/
Vcs-Svn: svn://svn.debian.org/pkg-perl/trunk/libparse-recdescent-perl
Vcs-Browser: http://svn.debian.org/viewsvn/pkg-perl/trunk/libparse-recdescent-perl/
Package: libparse-recdescent-perl
Architecture: all
-Depends: perl (>= 5.8), libversion-perl, ${misc:Depends}
+Depends: ${perl:Depends}, ${misc:Depends},
+ perl-modules (>= 5.10) | libversion-perl
Description: Perl module to create and use recursive-descent parsers
Parse::RecDescent incrementally generates top-down recursive-descent text
- parsers from simple yacc-like grammar specifications. It provides:
+ parsers from simple yacc-like grammar specifications. It provides:
.
- * Regular expressions or literal strings as terminals (tokens),
- * Multiple (non-contiguous) productions for any rule,
- * Repeated, optional and alternate sub-rules within productions,
+ * Regular expressions or literal strings as terminals (tokens)
+ * Multiple (non-contiguous) productions for any rule
+ * Repeated, optional and alternate sub-rules within productions
* Late-bound (run-time dispatched) sub-rules
- * Full access to Perl within actions specified as part of the grammar,
- * Simple automated error reporting during parser generation and parsing,
+ * Full access to Perl within actions specified as part of the grammar
+ * Simple automated error reporting during parser generation and parsing
* The ability to commit to, uncommit to, or reject particular productions
- during a parse,
- * Incremental extension of the parsing grammar (even during a parse),
+ during a parse
+ * Incremental extension of the parsing grammar (even during a parse)
* The ability to retrieve the generated parsing code.
Modified: trunk/libparse-recdescent-perl/demo/demo_calc.pl
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libparse-recdescent-perl/demo/demo_calc.pl?rev=42957&op=diff
==============================================================================
--- trunk/libparse-recdescent-perl/demo/demo_calc.pl (original)
+++ trunk/libparse-recdescent-perl/demo/demo_calc.pl Wed Aug 26 20:19:58 2009
@@ -1,4 +1,7 @@
-#! /usr/local/bin/perl -ws
+#! /opt/local/bin/perl5.10.0
+use v5.10;
+use warnings;
+
use Parse::RecDescent;
Modified: trunk/libparse-recdescent-perl/lib/Parse/RecDescent.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libparse-recdescent-perl/lib/Parse/RecDescent.pm?rev=42957&op=diff
==============================================================================
--- trunk/libparse-recdescent-perl/lib/Parse/RecDescent.pm (original)
+++ trunk/libparse-recdescent-perl/lib/Parse/RecDescent.pm Wed Aug 26 20:19:58 2009
@@ -1,6 +1,6 @@
# GENERATE RECURSIVE DESCENT PARSER OBJECTS FROM A GRAMMAR
-use 5.005;
+use 5.006;
use strict;
package Parse::RecDescent;
@@ -391,6 +391,7 @@
my %arg = ($#arg & 01) ? @arg : (@arg, undef);
my $text;
my $lastsep="";
+ my $current_match;
my $expectation = new Parse::RecDescent::Expectation(q{' . $self->expected() . '});
$expectation->at($_[1]);
'. ($parser->{_check}{thisoffset}?'
@@ -1129,7 +1130,7 @@
' . ($self->{"lookahead"}<0?'if':'unless')
. ' ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and '
. ($check->{itempos}? 'do {'.Parse::RecDescent::Production::incitempos().' 1} and ' : '')
- . ' $text =~ s' . $ldel . '\A(?:' . $self->{"pattern"} . ')'
+ . ' $text =~ s' . $ldel . '(\A(?:' . $self->{"pattern"} . '))'
. $rdel . $sdel . $mod . ')
{
'.($self->{"lookahead"} ? '$text = $_savetext;' : '').'
@@ -1140,11 +1141,12 @@
last;
}
+ $current_match = $1;
Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
- . $& . q{])},
+ . $current_match . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
- push @item, $item{'.$self->{hashname}.'}=$&;
+ push @item, $item{'.$self->{hashname}.'}=$current_match;
' . ($self->{"lookahead"} ? '$text = $_savetext;' : '' ) .'
';
@@ -1201,7 +1203,7 @@
' . ($self->{"lookahead"}<0?'if':'unless')
. ' ($text =~ s/\A($skip)/$lastsep=$1 and ""/e and '
. ($check->{itempos}? 'do {'.Parse::RecDescent::Production::incitempos().' 1} and ' : '')
- . ' $text =~ s/\A' . quotemeta($self->{"pattern"}) . '//)
+ . ' $text =~ s/(\A' . quotemeta($self->{"pattern"}) . ')//)
{
'.($self->{"lookahead"} ? '$text = $_savetext;' : '').'
$expectation->failed();
@@ -1210,11 +1212,12 @@
if defined $::RD_TRACE;
last;
}
+ $current_match = $1;
Parse::RecDescent::_trace(q{>>Matched terminal<< (return value: [}
- . $& . q{])},
+ . $current_match . q{])},
Parse::RecDescent::_tracefirst($text))
if defined $::RD_TRACE;
- push @item, $item{'.$self->{hashname}.'}=$&;
+ push @item, $item{'.$self->{hashname}.'}=$current_match;
' . ($self->{"lookahead"} ? '$text = $_savetext;' : '' ) .'
';
@@ -1719,7 +1722,7 @@
my $ERRORS = 0;
-use version; $VERSION = qv('1.96.0');
+use version; our $VERSION = qv('1.962.0');
# BUILDING A PARSER
@@ -1857,7 +1860,11 @@
my $aftererror = 0;
my $lookahead = 0;
my $lookaheadspec = "";
- push @lines, _linecount($grammar) unless $lines[-1];
+ my $must_pop_lines;
+ if (! $lines[-1]) {
+ push @lines, _linecount($grammar) ;
+ $must_pop_lines = 1;
+ }
$self->{_check}{itempos} = ($grammar =~ /\@itempos\b|\$itempos\s*\[/)
unless $self->{_check}{itempos};
for (qw(thisoffset thiscolumn prevline prevoffset prevcolumn))
@@ -1888,19 +1895,19 @@
my @components = ();
if ($grammar =~ m/$COMMENT/gco)
{
- _parse("a comment",0,$line);
+ _parse("a comment",0,$line, substr($grammar, $-[0], $+[0] - $-[0]) );
next;
}
elsif ($grammar =~ m/$NEGLOOKAHEAD/gco)
{
- _parse("a negative lookahead",$aftererror,$line);
+ _parse("a negative lookahead",$aftererror,$line, substr($grammar, $-[0], $+[0] - $-[0]) );
$lookahead = $lookahead ? -$lookahead : -1;
$lookaheadspec .= $1;
next; # SKIP LOOKAHEAD RESET AT END OF while LOOP
}
elsif ($grammar =~ m/$POSLOOKAHEAD/gco)
{
- _parse("a positive lookahead",$aftererror,$line);
+ _parse("a positive lookahead",$aftererror,$line, substr($grammar, $-[0], $+[0] - $-[0]) );
$lookahead = $lookahead ? $lookahead : 1;
$lookaheadspec .= $1;
next; # SKIP LOOKAHEAD RESET AT END OF while LOOP
@@ -1952,7 +1959,7 @@
{ }
elsif ($grammar =~ m/$BADREP/gco)
{
- _parse("an invalid repetition specifier", 0,$line);
+ _parse("an invalid repetition specifier", 0,$line, substr($grammar, $-[0], $+[0] - $-[0]) );
_error("Incorrect specification of a repeated directive",
$line);
_hint("Repeated directives cannot have
@@ -1975,7 +1982,7 @@
}
elsif ($grammar =~ m/$UNCOMMITMK/gco)
{
- _parse("an uncommit marker", $aftererror,$line);
+ _parse("an uncommit marker", $aftererror,$line, substr($grammar, $-[0], $+[0] - $-[0]) );
$item = new Parse::RecDescent::Directive('$commit=0;1',
$lookahead,$line,"<uncommit>");
$prod and $prod->additem($item)
@@ -1983,7 +1990,7 @@
}
elsif ($grammar =~ m/$QUOTELIKEMK/gco)
{
- _parse("an perl quotelike marker", $aftererror,$line);
+ _parse("an perl quotelike marker", $aftererror,$line, substr($grammar, $-[0], $+[0] - $-[0]) );
$item = new Parse::RecDescent::Directive(
'my ($match, at res);
($match,$text,undef, at res) =
@@ -1996,7 +2003,7 @@
elsif ($grammar =~ m/$CODEBLOCKMK/gco)
{
my $outer = $1||"{}";
- _parse("an perl codeblock marker", $aftererror,$line);
+ _parse("an perl codeblock marker", $aftererror,$line, substr($grammar, $-[0], $+[0] - $-[0]) );
$item = new Parse::RecDescent::Directive(
'Text::Balanced::extract_codeblock($text,undef,$skip,\''.$outer.'\');
', $lookahead,$line,"<perl_codeblock>");
@@ -2005,7 +2012,7 @@
}
elsif ($grammar =~ m/$VARIABLEMK/gco)
{
- _parse("an perl variable marker", $aftererror,$line);
+ _parse("an perl variable marker", $aftererror,$line, substr($grammar, $-[0], $+[0] - $-[0]) );
$item = new Parse::RecDescent::Directive(
'Text::Balanced::extract_variable($text,$skip);
', $lookahead,$line,"<perl_variable>");
@@ -2014,7 +2021,7 @@
}
elsif ($grammar =~ m/$NOCHECKMK/gco)
{
- _parse("a disable checking marker", $aftererror,$line);
+ _parse("a disable checking marker", $aftererror,$line, substr($grammar, $-[0], $+[0] - $-[0]) );
if ($rule)
{
_error("<nocheck> directive not at start of grammar", $line);
@@ -2030,19 +2037,20 @@
}
elsif ($grammar =~ m/$AUTOSTUBMK/gco)
{
- _parse("an autostub marker", $aftererror,$line);
+ _parse("an autostub marker", $aftererror,$line, substr($grammar, $-[0], $+[0] - $-[0]) );
$::RD_AUTOSTUB = "";
}
elsif ($grammar =~ m/$AUTORULEMK/gco)
{
- _parse("an autorule marker", $aftererror,$line);
+ _parse("an autorule marker", $aftererror,$line, substr($grammar, $-[0], $+[0] - $-[0]) );
$::RD_AUTOSTUB = $1;
}
elsif ($grammar =~ m/$AUTOTREEMK/gco)
{
my $base = defined($1) ? $1 : "";
+ my $current_match = substr($grammar, $-[0], $+[0] - $-[0]);
$base .= "::" if $base && $base !~ /::$/;
- _parse("an autotree marker", $aftererror,$line);
+ _parse("an autotree marker", $aftererror,$line, $current_match);
if ($rule)
{
_error("<autotree> directive not at start of grammar", $line);
@@ -2063,7 +2071,7 @@
elsif ($grammar =~ m/$REJECTMK/gco)
{
- _parse("an reject marker", $aftererror,$line);
+ _parse("an reject marker", $aftererror,$line, substr($grammar, $-[0], $+[0] - $-[0]) );
$item = new Parse::RecDescent::UncondReject($lookahead,$line,"<reject>");
$prod and $prod->additem($item)
or _no_rule("<reject>",$line);
@@ -2072,7 +2080,7 @@
and do { ($code) = extract_codeblock($grammar,'{',undef,'<');
$code })
{
- _parse("a (conditional) reject marker", $aftererror,$line);
+ _parse("a (conditional) reject marker", $aftererror,$line, $code );
$code =~ /\A\s*<reject:(.*)>\Z/s;
my $cond = $1;
$item = new Parse::RecDescent::Directive(
@@ -2084,7 +2092,7 @@
and do { ($code) = extract_codeblock($grammar,'{',undef,'<');
$code })
{
- _parse("a score marker", $aftererror,$line);
+ _parse("a score marker", $aftererror,$line, $code );
$code =~ /\A\s*<score:(.*)>\Z/s;
$prod and $prod->addscore($1, $lookahead, $line)
or _no_rule($code,$line);
@@ -2106,9 +2114,9 @@
}
elsif ($grammar =~ m/$RESYNCMK/gco)
{
- _parse("a resync to newline marker", $aftererror,$line);
+ _parse("a resync to newline marker", $aftererror,$line, substr($grammar, $-[0], $+[0] - $-[0]) );
$item = new Parse::RecDescent::Directive(
- 'if ($text =~ s/\A[^\n]*\n//) { $return = 0; $& } else { undef }',
+ 'if ($text =~ s/(\A[^\n]*\n)//) { $return = 0; $1; } else { undef }',
$lookahead,$line,"<resync>");
$prod and $prod->additem($item)
or _no_rule("<resync>",$line);
@@ -2117,10 +2125,10 @@
and do { ($code) = extract_bracketed($grammar,'<');
$code })
{
- _parse("a resync with pattern marker", $aftererror,$line);
+ _parse("a resync with pattern marker", $aftererror,$line, $code );
$code =~ /\A\s*<resync:(.*)>\Z/s;
$item = new Parse::RecDescent::Directive(
- 'if ($text =~ s/\A'.$1.'//) { $return = 0; $& } else { undef }',
+ 'if ($text =~ s/(\A'.$1.')//) { $return = 0; $1; } else { undef }',
$lookahead,$line,$code);
$prod and $prod->additem($item)
or _no_rule($code,$line);
@@ -2129,7 +2137,7 @@
and do { ($code) = extract_codeblock($grammar,'<');
$code })
{
- _parse("a skip marker", $aftererror,$line);
+ _parse("a skip marker", $aftererror,$line, $code );
$code =~ /\A\s*<skip:(.*)>\Z/s;
$item = new Parse::RecDescent::Directive(
'my $oldskip = $skip; $skip='.$1.'; $oldskip',
@@ -2217,36 +2225,36 @@
}
elsif ($grammar =~ m/$COMMITMK/gco)
{
- _parse("an commit marker", $aftererror,$line);
+ _parse("an commit marker", $aftererror,$line, substr($grammar, $-[0], $+[0] - $-[0]) );
$item = new Parse::RecDescent::Directive('$commit = 1',
$lookahead,$line,"<commit>");
$prod and $prod->additem($item)
or _no_rule("<commit>",$line);
}
elsif ($grammar =~ m/$NOCHECKMK/gco) {
- _parse("an hint request", $aftererror,$line);
+ _parse("an hint request", $aftererror,$line, substr($grammar, $-[0], $+[0] - $-[0]) );
$::RD_CHECK = 0;
}
elsif ($grammar =~ m/$HINTMK/gco) {
- _parse("an hint request", $aftererror,$line);
+ _parse("an hint request", $aftererror,$line, substr($grammar, $-[0], $+[0] - $-[0]) );
$::RD_HINT = $self->{__HINT__} = 1;
}
elsif ($grammar =~ m/$WARNMK/gco) {
- _parse("an warning request", $aftererror,$line);
+ _parse("an warning request", $aftererror,$line, substr($grammar, $-[0], $+[0] - $-[0]) );
$::RD_WARN = $self->{__WARN__} = $1 ? $2+0 : 1;
}
elsif ($grammar =~ m/$TRACEBUILDMK/gco) {
- _parse("an grammar build trace request", $aftererror,$line);
+ _parse("an grammar build trace request", $aftererror,$line, substr($grammar, $-[0], $+[0] - $-[0]) );
$::RD_TRACE = $1 ? $2+0 : 1;
}
elsif ($grammar =~ m/$TRACEPARSEMK/gco) {
- _parse("an parse trace request", $aftererror,$line);
+ _parse("an parse trace request", $aftererror,$line, substr($grammar, $-[0], $+[0] - $-[0]) );
$self->{__TRACE__} = $1 ? $2+0 : 1;
}
elsif ($grammar =~ m/$AUTOERRORMK/gco)
{
$commitonly = $1;
- _parse("an error marker", $aftererror,$line);
+ _parse("an error marker", $aftererror,$line, substr($grammar, $-[0], $+[0] - $-[0]) );
$item = new Parse::RecDescent::Error('',$lookahead,$1,$line);
$prod and $prod->additem($item)
or _no_rule("<error>",$line);
@@ -2293,7 +2301,7 @@
elsif ($grammar =~ m/$RULE/gco)
{
_parseunneg("a rule declaration", 0,
- $lookahead,$line) or next;
+ $lookahead,$line, substr($grammar, $-[0], $+[0] - $-[0]) ) or next;
my $rulename = $1;
if ($rulename =~ /Replace|Extend|Precompile|Save/ )
{
@@ -2318,7 +2326,7 @@
{
pos($grammar)-=9;
_parseunneg("a new (uncommitted) production",
- 0, $lookahead, $line) or next;
+ 0, $lookahead, $line, substr($grammar, $-[0], $+[0] - $-[0]) ) or next;
$prod->check_pending($line) if $prod;
$prod = new Parse::RecDescent::Production($line,1);
@@ -2330,7 +2338,7 @@
{
pos($grammar)-=6;
_parseunneg("a new (error) production", $aftererror,
- $lookahead,$line) or next;
+ $lookahead,$line, substr($grammar, $-[0], $+[0] - $-[0]) ) or next;
$prod->check_pending($line) if $prod;
$prod = new Parse::RecDescent::Production($line,0,1);
$rule and $rule->addprod($prod)
@@ -2340,7 +2348,7 @@
elsif ($grammar =~ m/$PROD/gco)
{
_parseunneg("a new production", 0,
- $lookahead,$line) or next;
+ $lookahead,$line, substr($grammar, $-[0], $+[0] - $-[0]) ) or next;
$rule
and (!$prod || $prod->check_pending($line))
and $prod = $rule->addprod(new Parse::RecDescent::Production($line))
@@ -2357,14 +2365,14 @@
}
elsif ($grammar =~ m/$INTERPLIT/gco)
{
- _parse("an interpolated literal terminal", $aftererror,$line);
+ _parse("an interpolated literal terminal", $aftererror,$line, substr($grammar, $-[0], $+[0] - $-[0]) );
$item = new Parse::RecDescent::InterpLit($1,$lookahead,$line);
$prod and $prod->additem($item)
or _no_rule("interpolated literal terminal",$line,"'$1'");
}
elsif ($grammar =~ m/$TOKEN/gco)
{
- _parse("a /../ pattern terminal", $aftererror,$line);
+ _parse("a /../ pattern terminal", $aftererror,$line, substr($grammar, $-[0], $+[0] - $-[0]) );
$item = new Parse::RecDescent::Token($1,'/',$3?$3:'',$lookahead,$line);
$prod and $prod->additem($item)
or _no_rule("pattern terminal",$line,"/$1/");
@@ -2574,14 +2582,15 @@
}
elsif ($grammar =~ m/$BADREP/gco)
{
- _parse("an subrule match with invalid repetition specifier", 0,$line);
+ my $current_match = substr($grammar, $-[0], $+[0] - $-[0]);
+ _parse("an subrule match with invalid repetition specifier", 0,$line, $current_match);
_error("Incorrect specification of a repeated subrule",
$line);
- _hint("Repeated subrules like \"$code$argcode$&\" cannot have
+ _hint("Repeated subrules like \"$code$argcode$current_match\" cannot have
a maximum repetition of zero, nor can they have
negative components in their ranges.");
}
- }
+ }
else
{
_parse("a subrule match", $aftererror,$line,$code);
@@ -2645,7 +2654,10 @@
$grammar =~ m/\G\s+/gc;
}
- pop @lines;
+
+ if ($must_pop_lines) {
+ pop @lines;
+ }
unless ($ERRORS or $isimplicit or !$::RD_CHECK)
{
@@ -2708,13 +2720,14 @@
)
{
return unless $1 eq $subrule && $min > 0;
- _warn(3,"Subrule sequence \"$subrule($repspec) $&\" will
+ my $current_match = substr($grammar, $-[0], $+[0] - $-[0]);
+ _warn(3,"Subrule sequence \"$subrule($repspec) $current_match\" will
(almost certainly) fail.",$line)
and
_hint("Unless subrule \"$subrule\" performs some cunning
lookahead, the repetition \"$subrule($repspec)\" will
insatiably consume as many matches of \"$subrule\" as it
- can, leaving none to match the \"$&\" that follows.");
+ can, leaving none to match the \"$current_match\" that follows.");
}
}
@@ -3049,22 +3062,22 @@
}
}
-sub _parseunneg($$$$)
-{
- _parse($_[0],$_[1],$_[3]);
+sub _parseunneg($$$$$)
+{
+ _parse($_[0],$_[1],$_[3],$_[4]);
if ($_[2]<0)
{
- _error("Can't negate \"$&\".",$_[3]);
+ _error("Can't negate \"$_[4]\".",$_[3]);
_hint("You can't negate $_[0]. Remove the \"...!\" before
- \"$&\".");
+ \"$_[4]\".");
return 0;
}
return 1;
}
-sub _parse($$$;$)
-{
- my $what = $_[3] || $&;
+sub _parse($$$$)
+{
+ my $what = $_[3];
$what =~ s/^\s+//;
if ($_[1])
{
@@ -5192,9 +5205,9 @@
list, since the C<E<lt>leftop:...E<gt>> and C<E<lt>rightop:...E<gt>> directives
require at least a single right or left operand to match. To specify
that the operator can match "trivially",
-it's necessary to add a C<(?)> qualifier to the directive:
-
- list: '(' <leftop: list_item /(,|=>)/ list_item>(?) ')'
+it's necessary to add a C<(s?)> qualifier to the directive:
+
+ list: '(' <leftop: list_item /(,|=>)/ list_item>(s?) ')'
Note that in almost all the above examples, the first and third arguments
of the C<<leftop:...E<gt>> directive were the same subrule. That is because
More information about the Pkg-perl-cvs-commits
mailing list