From: Yves Orton <demerphq@gmail.com>
Date: Tue, 30 Jan 2007 23:51:27 +0000 (+0100)
Subject: $1 in nested regex EVAL doesnt work correctly.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ded05c2a789e70bb7204e21b2aa98c6d1ac776c2;hp=33fb7a6edc5251e55242be2c5935f334082dd9b7;p=p5sagit%2Fp5-mst-13.2.git

$1 in nested regex EVAL doesnt work correctly.
Message-ID: <9b18b3110701301451l1443a186p39df7a6e8b65ea3c@mail.gmail.com>

p4raw-id: //depot/perl@30081
---

diff --git a/ext/re/lib/re/Tie/Hash/NamedCapture.pm b/ext/re/lib/re/Tie/Hash/NamedCapture.pm
index a76c6ab..b86463d 100644
--- a/ext/re/lib/re/Tie/Hash/NamedCapture.pm
+++ b/ext/re/lib/re/Tie/Hash/NamedCapture.pm
@@ -2,6 +2,7 @@ package re::Tie::Hash::NamedCapture;
 use strict;
 use warnings;
 our $VERSION     = "0.01";
+no re 'debug';
 use re qw(is_regexp
           regname
           regnames
diff --git a/ext/re/re.pm b/ext/re/re.pm
index 4a64af3..4f8d410 100644
--- a/ext/re/re.pm
+++ b/ext/re/re.pm
@@ -138,6 +138,7 @@ sub bits {
         } 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}) {
diff --git a/regcomp.c b/regcomp.c
index db25fb2..18f432b 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -4669,8 +4669,9 @@ Perl_reg_named_buff_get(pTHX_ SV* namesv, const REGEXP * const from_re, U32 flag
                 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) 
diff --git a/regexec.c b/regexec.c
index c475b9a..cad8f61 100644
--- a/regexec.c
+++ b/regexec.c
@@ -2134,6 +2134,8 @@ phooey:
 }
 
 
+
+
 /*
  - regtry - try match at specific point
  */
@@ -3574,6 +3576,9 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
             } 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 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
 		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 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
                     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 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
 		PL_op = oop;
 		PAD_RESTORE_LOCAL(old_comppad);
 		PL_curcop = ocurcop;
+
 		if (!logical) {
 		    /* /(?{...})/ */
 		    sv_setsv(save_scalar(PL_replgv), ret);
@@ -3651,6 +3662,12 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
 		    }
 		}
 		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 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
                         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 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
 		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;
diff --git a/t/op/pat.t b/t/op/pat.t
index 94703c1..806e8cd 100755
--- a/t/op/pat.t
+++ b/t/op/pat.t
@@ -4256,7 +4256,23 @@ for my $c ("z", "\0", "!", chr(254), chr(256)) {
     $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 @@ ok($@=~/\QSequence \k... not terminated in regex;\E/);
 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";
 }