Change 30081 by [EMAIL PROTECTED] on 2007/01/31 07:34:39
Subject: [PATCH] $1 in nested regex EVAL doesnt work correctly.
From: demerphq <[EMAIL PROTECTED]>
Date: Tue, 30 Jan 2007 23:51:27 +0100
Message-ID: <[EMAIL PROTECTED]>
Affected files ...
... //depot/perl/ext/re/lib/re/Tie/Hash/NamedCapture.pm#2 edit
... //depot/perl/ext/re/re.pm#44 edit
... //depot/perl/regcomp.c#546 edit
... //depot/perl/regexec.c#508 edit
... //depot/perl/t/op/pat.t#276 edit
Differences ...
==== //depot/perl/ext/re/lib/re/Tie/Hash/NamedCapture.pm#2 (text) ====
Index: perl/ext/re/lib/re/Tie/Hash/NamedCapture.pm
--- perl/ext/re/lib/re/Tie/Hash/NamedCapture.pm#1~29682~ 2007-01-04
06:30:02.000000000 -0800
+++ perl/ext/re/lib/re/Tie/Hash/NamedCapture.pm 2007-01-30 23:34:39.000000000
-0800
@@ -2,6 +2,7 @@
use strict;
use warnings;
our $VERSION = "0.01";
+no re 'debug';
use re qw(is_regexp
regname
regnames
==== //depot/perl/ext/re/re.pm#44 (text) ====
Index: perl/ext/re/re.pm
--- perl/ext/re/re.pm#43~29682~ 2007-01-04 06:30:02.000000000 -0800
+++ perl/ext/re/re.pm 2007-01-30 23:34:39.000000000 -0800
@@ -138,6 +138,7 @@
} elsif ($s eq 'debug' or $s eq 'debugcolor') {
setcolor() if $s =~/color/i;
_load_unload($on);
+ last;
} elsif (exists $bitmask{$s}) {
$bits |= $bitmask{$s};
} elsif ($EXPORT_OK{$s}) {
==== //depot/perl/regcomp.c#546 (text) ====
Index: perl/regcomp.c
--- perl/regcomp.c#545~29991~ 2007-01-26 01:01:01.000000000 -0800
+++ perl/regcomp.c 2007-01-30 23:34:39.000000000 -0800
@@ -4669,8 +4669,9 @@
SV* sv_dat=HeVAL(he_str);
I32 *nums=(I32*)SvPVX(sv_dat);
for ( i=0; i<SvIVX(sv_dat); i++ ) {
- if ((I32)(rx->lastparen) >= nums[i] &&
- rx->endp[nums[i]] != -1)
+ if ((I32)(rx->nparens) >= nums[i]
+ && rx->startp[nums[i]] != -1
+ && rx->endp[nums[i]] != -1)
{
ret = reg_numbered_buff_get(nums[i],rx,NULL,0);
if (!retarray)
==== //depot/perl/regexec.c#508 (text) ====
Index: perl/regexec.c
--- perl/regexec.c#507~29756~ 2007-01-11 06:47:01.000000000 -0800
+++ perl/regexec.c 2007-01-30 23:34:39.000000000 -0800
@@ -2134,6 +2134,8 @@
}
+
+
/*
- regtry - try match at specific point
*/
@@ -3574,6 +3576,9 @@
} else {
nochange_depth = 0;
}
+ { regexp *ocurpm = PM_GETRE(PL_curpm);
+ char *osubbeg = rex->subbeg;
+ STRLEN osublen = rex->sublen;
{
/* execute the code in the {...} */
dSP;
@@ -3581,6 +3586,7 @@
OP_4tree * const oop = PL_op;
COP * const ocurcop = PL_curcop;
PAD *old_comppad;
+
n = ARG(scan);
PL_op = (OP_4tree*)rexi->data->data[n];
@@ -3593,6 +3599,10 @@
SV *sv_mrk = get_sv("REGMARK", 1);
sv_setsv(sv_mrk, sv_yes_mark);
}
+ /* make sure that $1 and friends are available with nested
eval */
+ PM_SETRE(PL_curpm,rex);
+ rex->subbeg = ocurpm->subbeg;
+ rex->sublen = ocurpm->sublen;
CALLRUNOPS(aTHX); /* Scalar context. */
SPAGAIN;
@@ -3606,6 +3616,7 @@
PL_op = oop;
PAD_RESTORE_LOCAL(old_comppad);
PL_curcop = ocurcop;
+
if (!logical) {
/* /(?{...})/ */
sv_setsv(save_scalar(PL_replgv), ret);
@@ -3651,6 +3662,12 @@
}
}
rei = RXi_GET(re);
+
+ /* restore PL_curpm after the eval */
+ PM_SETRE(PL_curpm,ocurpm);
+ rex->sublen = osublen;
+ rex->subbeg = osubbeg;
+
DEBUG_EXECUTE_r(
debug_start_match(re, do_utf8, locinput, PL_regeol,
"Matching embedded");
@@ -3664,7 +3681,8 @@
Renew(PL_reg_start_tmp, PL_reg_start_tmpl, char*);
else
Newx(PL_reg_start_tmp, PL_reg_start_tmpl, char*);
- }
+ }
+
eval_recurse_doit: /* Share code with GOSUB below this line */
/* run the pattern returned from (??{...}) */
@@ -3701,6 +3719,11 @@
PUSH_YES_STATE_GOTO(EVAL_AB, startpoint);
/* NOTREACHED */
}
+ /* restore PL_curpm after the eval */
+ PM_SETRE(PL_curpm,ocurpm);
+ rex->sublen = osublen;
+ rex->subbeg = osubbeg;
+ }
/* logical is 1, /(?(?{...})X|Y)/ */
sw = (bool)SvTRUE(ret);
logical = 0;
==== //depot/perl/t/op/pat.t#276 (xtext) ====
Index: perl/t/op/pat.t
--- perl/t/op/pat.t#275~29756~ 2007-01-11 06:47:01.000000000 -0800
+++ perl/t/op/pat.t 2007-01-30 23:34:39.000000000 -0800
@@ -4256,7 +4256,23 @@
$x =~ s/(.)\K/$1/g;
ok($x eq "aabbccddee");
}
+sub kt
+{
+ return '4' if $_[0] eq '09028623';
+}
+{ # Nested EVAL using PL_curpm (via $1 or friends)
+ my $re;
+ our $grabit = qr/ ([0-6][0-9]{7}) (??{ kt $1 }) [890] /x;
+ $re = qr/^ ( (??{ $grabit }) ) $ /x;
+ my @res = '0902862349' =~ $re;
+ iseq(join("-",@res),"0902862349",
+ 'PL_curpm is set properly on nested eval');
+
+ our $qr = qr/ (o) (??{ $1 }) /x;
+ ok( 'boob'=~/( b (??{ $qr }) b )/x && 1,
+ "PL_curpm, nested eval");
+}
# Test counter is at bottom of file. Put new tests above here.
#-------------------------------------------------------------------
@@ -4307,7 +4323,7 @@
iseq(0+$::test,$::TestCount,"Got the right number of tests!");
# Don't forget to update this!
BEGIN {
- $::TestCount = 1620;
+ $::TestCount = 1622;
print "1..$::TestCount\n";
}
End of Patch.
