fix lvalue context for 4-arg substr

4-arg substr uses its first arg as an lvalue, but wasn't lvaluifying
it properly.  [perl #115258]

diff --git a/op.c b/op.c
index c617ad2..2e4dae4 100644 (file)
--- a/op.c
+++ b/op.c
@@ -13385,7 +13385,7 @@ Perl_ck_substr(pTHX_ OP *o)
        if (kid->op_type == OP_NULL)
            kid = OpSIBLING(kid);
        if (kid)
-           kid->op_flags |= OPf_MOD;
+           op_lvalue(kid, o->op_type);
 
     }
     return o;

diff --git a/t/op/substr.t b/t/op/substr.t
index 3d850f5..dade46d 100644 (file)
--- a/t/op/substr.t
+++ b/t/op/substr.t
@@ -22,7 +22,7 @@ $SIG{__WARN__} = sub {
      }
 };
 
-plan(392);
+plan(399);
 
 run_tests() unless caller;
 
@@ -883,4 +883,30 @@ fresh_perl_is('$0 = "/usr/bin/perl"; substr($0, 0, 0, $0)', '', {}, "(perl #1293
     is $x, "\x{100}zzzz", "RT#130624: heap-use-after-free in 4-arg substr (targ)";
 }
 
+{
+    our @ta;
+    $#ta = -1;
+    substr($#ta, 0, 2) = 23;
+    is $#ta, 23;
+    $#ta = -1;
+    substr($#ta, 0, 2) =~ s/\A..\z/23/s;
+    is $#ta, 23;
+    $#ta = -1;
+    substr($#ta, 0, 2, 23);
+    is $#ta, 23;
+    sub ta_tindex :lvalue { $#ta }
+    $#ta = -1;
+    ta_tindex() = 23;
+    is $#ta, 23;
+    $#ta = -1;
+    substr(ta_tindex(), 0, 2) = 23;
+    is $#ta, 23;
+    $#ta = -1;
+    substr(ta_tindex(), 0, 2) =~ s/\A..\z/23/s;
+    is $#ta, 23;
+    $#ta = -1;
+    substr(ta_tindex(), 0, 2, 23);
+    is $#ta, 23;
+}
 
+1;