From: Moritz Lenz <moritz@casella.verplant.org>
Date: Sat, 5 Jan 2008 17:14:37 +0000 (+0100)
Subject: Fix regexec.c so $^N and $+ are correctly updated so that they work properly inside... 
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0357f1fd55a0c9e8fad7103cf9d7638747f9d9ee;p=p5sagit%2Fp5-mst-13.2.git

Fix regexec.c so $^N and $+ are correctly updated so that they work properly inside of (?{...}) blocks as reported by Moritz Lenz in

Subject: Bugs in extended regexp features
Message-ID: <477FACED.4000505@casella.verplant.org>

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

diff --git a/regexec.c b/regexec.c
index e6527f5..6496694 100644
--- a/regexec.c
+++ b/regexec.c
@@ -3807,8 +3807,12 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
 		
 		PL_regoffs = re->offs; /* essentially NOOP on GOSUB */
 		
-		*PL_reglastparen = 0;
-		*PL_reglastcloseparen = 0;
+		/* see regtry, specifically PL_reglast(?:close)?paren is a pointer! (i dont know why) :dmq */
+		PL_reglastparen = &re->lastparen;
+		PL_reglastcloseparen = &re->lastcloseparen;
+		re->lastparen = 0;
+		re->lastcloseparen = 0;
+
 		PL_reginput = locinput;
 		PL_regsize = 0;
 
@@ -3851,6 +3855,10 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
 	    regcpblow(ST.cp);
 	    cur_eval = ST.prev_eval;
 	    cur_curlyx = ST.prev_curlyx;
+	    
+	    PL_reglastparen = &rex->lastparen;
+	    PL_reglastcloseparen = &rex->lastcloseparen;
+	    
 	    /* XXXX This is too dramatic a measure... */
 	    PL_reg_maxiter = 0;
             if ( nochange_depth )
@@ -3865,6 +3873,9 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
 	    SETREX(rex_sv,ST.prev_rex);
 	    rex = (struct regexp *)SvANY(rex_sv);
 	    rexi = RXi_GET(rex); 
+	    PL_reglastparen = &rex->lastparen;
+	    PL_reglastcloseparen = &rex->lastcloseparen;
+
 	    PL_reginput = locinput;
 	    REGCP_UNWIND(ST.lastcp);
 	    regcppop(rex);
diff --git a/t/op/pat.t b/t/op/pat.t
index 26c4cb3..0e16cd9 100755
--- a/t/op/pat.t
+++ b/t/op/pat.t
@@ -4525,6 +4525,31 @@ sub kt
      s/(*:X)A+|(*:Y)B+|(*:Z)C+/$REGMARK/g;
      iseq $_, "ZYX";
 }
+{
+    our @ctl_n=();
+    our @plus=();
+    our $nested_tags;
+    $nested_tags = qr{
+        <
+           (\w+)
+           (?{
+                   push @ctl_n,$^N;
+                   push @plus,$+;
+           })
+        >
+        (??{$nested_tags})*
+        </\s* \w+ \s*>
+    }x;
+
+    my $match= '<bla><blubb></blubb></bla>' =~ m/^$nested_tags$/;
+    ok($match,'nested construct matches');
+    iseq("@ctl_n","bla blubb",'$^N inside of (?{}) works as expected');
+    iseq("@plus","bla blubb",'$+ inside of (?{}) works as expected');
+}
+
+
+
+
 # Test counter is at bottom of file. Put new tests above here.
 #-------------------------------------------------------------------
 # Keep the following tests last -- they may crash perl
@@ -4583,6 +4608,6 @@ 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 = 4016;
+    $::TestCount = 4019;
     print "1..$::TestCount\n";
 }