Permalink
Browse files

mutlitconcat: fix non-folding adjacent consts

RT ##132646

v5.27.6-120-gbcc30fd changed multiconcat so that adjacent constants
weren't folded, so that ($overloaded . "a" . "b") is invoked as
    $overloaded->concat("a")->concat("b")
rather than
    $overloaded->concat("ab")

It did this by 'demoting' every second adjacent const as a real arg rather
than adding it to the const string. However, that could leave a
multiconcat op with more than the maximum allowed args.

So include demotion candidates as part of the arg count.
  • Loading branch information...
iabyn committed Dec 25, 2017
1 parent 06c214d commit f08f2d0393c6f2ccdfc17ed791cd9956d95eaa4e
Showing with 40 additions and 2 deletions.
  1. +9 −1 op.c
  2. +31 −1 t/opbasic/concat.t
View
10 op.c
@@ -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)
View
@@ -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");
}

0 comments on commit f08f2d0

Please sign in to comment.