This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
multiconcat: don't fold adjacent constants
authorDavid Mitchell <davem@iabyn.com>
Mon, 4 Dec 2017 11:50:53 +0000 (11:50 +0000)
committerDavid Mitchell <davem@iabyn.com>
Mon, 4 Dec 2017 12:36:25 +0000 (12:36 +0000)
RT #132385

In something like

    $overloaded . "a" . "b"

perl used to do

    $overloaded->concat("a")->concat("b")

but since the introduction of OP_MULTICONCAT, started doing:

    $overloaded->concat("ab")

This commit restores the old behaviour, by keeping every second adjacent
OP_CONST as an arg rather than optimising it away and adding its contents
to the constant string in the aux struct.

But note that

    $overloaded .=  "a" . "b"

originally, and still, constant folds.

lib/overload.t
op.c
t/perf/opcount.t

index 75a7aa2..2afa6cf 100644 (file)
@@ -48,7 +48,7 @@ package main;
 
 $| = 1;
 BEGIN { require './test.pl'; require './charset_tools.pl' }
-plan tests => 5332;
+plan tests => 5338;
 
 use Scalar::Util qw(tainted);
 
@@ -2891,7 +2891,7 @@ package Concat {
     my ($r, $R);
 
 
-    # like c, but with $is_ref set to 1
+    # like cc, but with $is_ref set to 1
     sub c {
         my ($expr, $expect, $exp_id) = @_;
         cc($expr, $expect, 1, $exp_id);
@@ -2994,6 +2994,13 @@ package Concat {
     cc '$r.=sprintf("%s%s%s",$a,$B,$c)', 'raBc', 0, '("",[B],u,)';
     cc '$R.=sprintf("%s%s%s",$a,$B,$c)', 'RaBc', 1, '("",[B],u,)(.=,[R],aBc,u)'
                                                    .'("",[RaBc],u,)';
+
+    # multiple constants should individually overload (RT #132385)
+
+    c '$r=$A."b"."c"', 'Abc',  '(.,[A],b,)(.=,[Ab],c,u)("",[Abc],u,)';
+
+    # ... except for this
+    c '$R.="a"."b"',   'Rab',  '(.=,[R],ab,u)("",[Rab],u,)';
 }
 
 # RT #132385
diff --git a/op.c b/op.c
index 7030af0..7d0185f 100644 (file)
--- a/op.c
+++ b/op.c
@@ -2933,6 +2933,33 @@ S_maybe_multiconcat(pTHX_ OP *o)
     if (stacked_last)
         return; /* we don't support ((A.=B).=C)...) */
 
+    /* look for two adjacent consts and don't fold them together:
+     *     $o . "a" . "b"
+     * should do
+     *     $o->concat("a")->concat("b")
+     * rather than
+     *     $o->concat("ab")
+     * (but $o .=  "a" . "b" should still fold)
+     */
+    {
+        bool seen_nonconst = FALSE;
+        for (argp = toparg; argp >= args; argp--) {
+            if (argp->p == NULL) {
+                seen_nonconst = TRUE;
+                continue;
+            }
+            if (!seen_nonconst)
+                continue;
+            if (argp[1].p) {
+                /* both previous and current arg were constants;
+                 * leave the current OP_CONST as-is */
+                argp->p = NULL;
+                nconst--;
+                nargs++;
+            }
+        }
+    }
+
     /* -----------------------------------------------------------------
      * Phase 2:
      *
index 0ded6cd..2d0ade5 100644 (file)
@@ -20,7 +20,7 @@ BEGIN {
 use warnings;
 use strict;
 
-plan 2579;
+plan 2582;
 
 use B ();
 
@@ -634,3 +634,32 @@ test_opcount(0, "state works with multiconcat",
                     once        => 1,
                     padsv       => 2, # one each for the next/once branches
                 });
+
+# multiple concats of constants preceded by at least one non-constant
+# shouldn't get constant-folded so that a concat overload method is called
+# for each arg. So every second constant string is left as an OP_CONST
+
+test_opcount(0, "multiconcat: 2 adjacent consts",
+                sub { my ($a, $b); $a = $b . "c" . "d" },
+                {
+                    const       => 1,
+                    multiconcat => 1,
+                    concat      => 0,
+                    sassign     => 0,
+                });
+test_opcount(0, "multiconcat: 3 adjacent consts",
+                sub { my ($a, $b); $a = $b . "c" . "d" . "e" },
+                {
+                    const       => 1,
+                    multiconcat => 1,
+                    concat      => 0,
+                    sassign     => 0,
+                });
+test_opcount(0, "multiconcat: 4 adjacent consts",
+                sub { my ($a, $b); $a = $b . "c" . "d" . "e" ."f" },
+                {
+                    const       => 2,
+                    multiconcat => 1,
+                    concat      => 0,
+                    sassign     => 0,
+                });