From: Rafael Garcia-Suarez <rgarciasuarez@gmail.com>
Date: Sat, 23 Dec 2006 13:52:02 +0000 (+0000)
Subject: Fix RT #6006: Regexp replaces using large replacement variables fail
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3be6978253328b9f1f41af44a42a6ef871b7117e;p=p5sagit%2Fp5-mst-13.2.git

Fix RT #6006: Regexp replaces using large replacement variables fail
some of the time (i.e. when the substitution contains something
like ${10}). Patch derived from a patch by Hugo van der Sanden;
added also a second test (Yves Orton already added a TODO test
for this.)

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

diff --git a/op.c b/op.c
index 2c10b2b..69db999 100644
--- a/op.c
+++ b/op.c
@@ -3332,7 +3332,9 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg)
 		    else if (curop->op_type == OP_PADSV ||
 			     curop->op_type == OP_PADAV ||
 			     curop->op_type == OP_PADHV ||
-			     curop->op_type == OP_PADANY) {
+			     curop->op_type == OP_PADANY ||
+			     curop->op_type == OP_SCOPE /* ${10} */
+			     ) {
 			repl_has_vars = 1;
 		    }
 		    else if (curop->op_type == OP_PUSHRE)
@@ -3344,9 +3346,9 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg)
 	    }
 	}
 	if (curop == repl
-	    && !(repl_has_vars
-		 && (!PM_GETRE(pm)
-		     || PM_GETRE(pm)->extflags & RXf_EVAL_SEEN))) {
+	    && !repl_has_vars
+	    && (PM_GETRE(pm) && !PM_GETRE(pm)->extflags & RXf_EVAL_SEEN))
+	{
 	    pm->op_pmflags |= PMf_CONST;	/* const for long enough */
 	    pm->op_pmpermflags |= PMf_CONST;	/* const for long enough */
 	    prepend_elem(o->op_type, scalar(repl), o);
diff --git a/t/op/subst.t b/t/op/subst.t
index b9428e0..b4a824e 100755
--- a/t/op/subst.t
+++ b/t/op/subst.t
@@ -7,7 +7,7 @@ BEGIN {
 }
 
 require './test.pl';
-plan( tests => 135 );
+plan( tests => 136 );
 
 $x = 'foo';
 $_ = "x";
@@ -562,14 +562,15 @@ is($name, "cis", q[#22351 bug with 'e' substitution modifier]);
     ($c = "\x20\x00\x30\x01\x40\x1A\x50\x1F\x60") =~ s/[\x00-\x1f]//g;
     is($c, "\x20\x30\x40\x50\x60", "s/[\\x00-\\x1f]//g");
 }
-TODO:{
-    local $TODO = "RT#6006 needs resolution";
-    $TODO=$TODO;
+{
     $_ = "xy";
     no warnings 'uninitialized';
     /(((((((((x)))))))))(z)/;	# clear $10
     s/(((((((((x)))))))))(y)/${10}/;
     is($_,"y","RT#6006: \$_ eq '$_'");
+    $_ = "xr";
+    s/(((((((((x)))))))))(r)/fooba${10}/;
+    is($_,"foobar","RT#6006: \$_ eq '$_'");
 }
 {
     my $want=("\n" x 11).("B\n" x 11)."B";