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