diff --git a/op.c b/op.c index c617ad2a009b..2e4dae43c663 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 3d850f51e188..dade46d99f5a 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;