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.

1 files changed, 9 insertions, 1 deletions

diff --git a/op.c b/op.c
index 724dfef6ad..d9886482cd 100644
--- a/op.c
+++ b/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)