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]

2 files changed, 28 insertions, 2 deletions

diff --git a/op.c b/op.c
index c617ad2a00..2e4dae43c6 100644
--- 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 3d850f51e1..dade46d99f 100644
--- 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;