diff options
| -rw-r--r-- | op.c | 10 | ||||
| -rw-r--r-- | t/opbasic/concat.t | 32 |
2 files changed, 40 insertions, 2 deletions
@@ -2666,6 +2666,7 @@ S_maybe_multiconcat(pTHX_ OP *o) SSize_t nargs = 0; SSize_t nconst = 0; + SSize_t nadjconst = 0; /* adjacent consts - may be demoted to args */ STRLEN variant; bool utf8 = FALSE; bool kid_is_last = FALSE; /* most args will be the RHS kid of a concat op; @@ -2677,6 +2678,7 @@ S_maybe_multiconcat(pTHX_ OP *o) U8 private_flags = 0; /* ... op_private of the multiconcat op */ bool is_sprintf = FALSE; /* we're optimising an sprintf */ bool is_targable = FALSE; /* targetop is an OPpTARGET_MY candidate */ + bool prev_was_const = FALSE; /* previous arg was a const */ /* ----------------------------------------------------------------- * Phase 1: @@ -2893,7 +2895,7 @@ S_maybe_multiconcat(pTHX_ OP *o) last = TRUE; } - if ( nargs > PERL_MULTICONCAT_MAXARG - 2 + if ( nargs + nadjconst > PERL_MULTICONCAT_MAXARG - 2 || (argp - args + 1) > (PERL_MULTICONCAT_MAXARG*2 + 1) - 2) { /* At least two spare slots are needed to decompose both @@ -2924,10 +2926,16 @@ S_maybe_multiconcat(pTHX_ OP *o) argp++->p = sv; utf8 |= cBOOL(SvUTF8(sv)); nconst++; + if (prev_was_const) + /* this const may be demoted back to a plain arg later; + * make sure we have enough arg slots left */ + nadjconst++; + prev_was_const = !prev_was_const; } else { argp++->p = NULL; nargs++; + prev_was_const = FALSE; } if (last) diff --git a/t/opbasic/concat.t b/t/opbasic/concat.t index 55965c1702..42851d23b9 100644 --- a/t/opbasic/concat.t +++ b/t/opbasic/concat.t @@ -39,7 +39,7 @@ sub is { return $ok; } -print "1..251\n"; +print "1..252\n"; ($a, $b, $c) = qw(foo bar); @@ -810,3 +810,33 @@ ok(ref(CORE::state $y = "a $o b") eq 'o', is($got, $expected, "long concat chain $i"); } } + +# RT #132646 +# with adjacent consts, the second const is treated as an arg rather than a +# consts. Make sure this doesn't exceeed the maximum allowed number of +# args +{ + my $x = 'X'; + my $got = + 'A' . $x . 'B' . 'C' . $x . 'D' + . 'A' . $x . 'B' . 'C' . $x . 'D' + . 'A' . $x . 'B' . 'C' . $x . 'D' + . 'A' . $x . 'B' . 'C' . $x . 'D' + . 'A' . $x . 'B' . 'C' . $x . 'D' + . 'A' . $x . 'B' . 'C' . $x . 'D' + . 'A' . $x . 'B' . 'C' . $x . 'D' + . 'A' . $x . 'B' . 'C' . $x . 'D' + . 'A' . $x . 'B' . 'C' . $x . 'D' + . 'A' . $x . 'B' . 'C' . $x . 'D' + . 'A' . $x . 'B' . 'C' . $x . 'D' + . 'A' . $x . 'B' . 'C' . $x . 'D' + . 'A' . $x . 'B' . 'C' . $x . 'D' + . 'A' . $x . 'B' . 'C' . $x . 'D' + . 'A' . $x . 'B' . 'C' . $x . 'D' + . 'A' . $x . 'B' . 'C' . $x . 'D' + . 'A' . $x . 'B' . 'C' . $x . 'D' + ; + is ($got, + "AXBCXDAXBCXDAXBCXDAXBCXDAXBCXDAXBCXDAXBCXDAXBCXDAXBCXDAXBCXDAXBCXDAXBCXDAXBCXDAXBCXDAXBCXDAXBCXDAXBCXD", + "RT #132646"); +} |