$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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (executable)
--- 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";
 }