Skip to content

Commit

Permalink
OP_SUBSTR_LEFT: GH#22914 - multiple pointers to replacement OP
Browse files Browse the repository at this point in the history
The recent initial commit for OP_SUBSTR_LEFT failed to account for
there being multiple paths from a non-trivial LENGTH to the ""
replacement CONST OP. This could result in the replacement SV
being erroneously pushed to the stack, causing `pp_substr_left`
to try to operate on the wrong SV.

This commit nulls out the replacement OP, so that even if it
is encountered, no erroneous SV is pushed. Contrary to the
comment in the original commit, this actually does not break
B::Deparse.

Thanks to @mauke for figuring this out and preparing a patch
before I'd even opened my browser.
  • Loading branch information
richardleach committed Jan 15, 2025
1 parent 7a1c156 commit 8ccd351
Show file tree
Hide file tree
Showing 3 changed files with 22 additions and 10 deletions.
17 changes: 11 additions & 6 deletions peep.c
Original file line number Diff line number Diff line change
Expand Up @@ -3869,7 +3869,7 @@ Perl_rpeep(pTHX_ OP *o)
break;

case OP_SUBSTR: {
OP *expr, *offs, *len;
OP *expr, *offs, *len, *repl = NULL;
/* Specialize substr($x, 0, $y) and substr($x,0,$y,"") */
/* Does this substr have 3-4 args and amiable flags? */
if (
Expand Down Expand Up @@ -3897,7 +3897,7 @@ Perl_rpeep(pTHX_ OP *o)

if (cMAXARG3x(o) == 4) {/* replacement */
/* Is the replacement string CONST ""? */
OP *repl = OpSIBLING(len);
repl = OpSIBLING(len);
if (repl->op_type != OP_CONST)
break;
SV *repl_sv = cSVOPx_sv(repl);
Expand All @@ -3908,12 +3908,10 @@ Perl_rpeep(pTHX_ OP *o)
break;
}
/* It's on! */
/* Take out the static LENGTH & REPLACMENT OPs */
/* Take out the static LENGTH OP. */
/* (The finalizer does not seem to change op_next here) */
expr->op_next = offs->op_next;
o->op_private = cMAXARG3x(o);
if (cMAXARG3x(o) == 4)
len->op_next = o;

/* We have a problem if padrange pushes the expr OP for us,
* then jumps straight to the offs CONST OP. For example:
Expand All @@ -3924,7 +3922,14 @@ Perl_rpeep(pTHX_ OP *o)
* B::Deparse. :/ */
op_null(offs);

/* repl status unchanged because it makes Deparsing easier. */
/* There can be multiple pointers to repl, see GH #22914.
* substr $x, 0, $y ? 2 : 3, "";
* So instead of rewriting all of len, null out repl. */
if (repl) {
op_null(repl);
/* We can still rewrite the simple len case though.*/
len->op_next = o;
}

/* Upgrade the SUBSTR to a SUBSTR_LEFT */
OpTYPE_set(o, OP_SUBSTR_LEFT);
Expand Down
7 changes: 7 additions & 0 deletions t/op/substr_left.t
Original file line number Diff line number Diff line change
Expand Up @@ -104,5 +104,12 @@ $str = "\x00\x01\x02\x03\x04\x05";
$result = substr($str, 0, 3, "");
is($result, "\x00\x01\x02", 'hex EXPR: returns correct characters');
is($str, "\x03\x04\x05", 'hex EXPR: retains correct characters');
# GH #22914. LEN has more than one pointer to REPL.
$str = "perl";
# Hopefully $INC[0] ne '/dev/random' is a reasonable test assumption...
# (We need a condition that no future clever optimiser will strip)
$result = substr($str, 0, $INC[0] eq '/dev/random' ? 2: 3, '');
is($result, 'per', 'GH#22914: non-trivial LEN returns correct characters');
is($str, 'l', 'GH#22914: non-trivial LEN retains correct characters');

done_testing();
8 changes: 4 additions & 4 deletions t/perf/opcount.t
Original file line number Diff line number Diff line change
Expand Up @@ -1034,15 +1034,15 @@ test_opcount(0, "substr with const zero offset and '' repl (void)",
{
substr => 0,
substr_left => 1,
const => 2,
const => 1,
});

test_opcount(0, "substr with const zero offset and '' repl (lexical)",
sub { my $z; my $x = substr($z, 0, 2, "") },
{
substr => 0,
substr_left => 1,
const => 2,
const => 1,
padsv => 3,
sassign => 1
});
Expand All @@ -1052,7 +1052,7 @@ test_opcount(0, "substr with const zero offset and '' repl (lexical TARGMY)",
{
substr => 0,
substr_left => 1,
const => 2,
const => 1,
padsv => 3,
padsv_store => 0,
sassign => 0
Expand All @@ -1063,7 +1063,7 @@ test_opcount(0, "substr with const zero offset and '' repl (gv)",
{
substr => 0,
substr_left => 1,
const => 2,
const => 1,
gvsv => 1,
sassign => 1
});
Expand Down

0 comments on commit 8ccd351

Please sign in to comment.