multiconcat: keep assign for 'local $foo = "..."'

In something like

    local $~ = "$~X";

i.e. where localising a magic variable whose previous value should be
used as part of a string concat on the RHS, don't fold the assign into
the multiconcat op. Otherwise the code execution path looks a bit like:

    local($~) = undef;
    multiconcat($~, $~, "X");

[ where multiconcat's args are (target, arg1, arg2,....) ]
and thus multiconcat sees an undef arg.

By leaving the assign out of the multiconcat, code execution now looks
like
    my $targ;
    multiconcat($targ, $~, "X");
    local($~) = $targ;

See http://nntp.perl.org/group/perl.perl5.porters/256898,
    "Bug in format introduced in 5.27.6".

Although the bug only appears with magic vars, this patch pessimises
all forms of 'local $foo = "..."', 'local $foo{bar} = "..."' etc.
Strictly speaking the bug occurs because with 'local' you end up with
two SVs (the saved one and the one currently in the glob) which both
have the same container magic and where mg_set()ing one changes the
mg_get() value of the other. Thus, vars like $!. One of the two SVs
becomes an arg of multiconcat, the other becomes its target. Part of
localising the target SV (before multiconcat is called) wipes the value
of the arg SV.

diff --git a/op.c b/op.c
index 6e2897b..522b8d2 100644 (file)
--- a/op.c
+++ b/op.c
@@ -2915,6 +2915,18 @@ S_maybe_multiconcat(pTHX_ OP *o)
         targetop = OpSIBLING(topop);
         if (!targetop) /* probably some sort of syntax error */
             return;
+
+        /* don't optimise away assign in 'local $foo = ....' */
+        if (   (targetop->op_private & OPpLVAL_INTRO)
+            /* these are the common ops which do 'local', but
+             * not all */
+            && (   targetop->op_type == OP_GVSV
+                || targetop->op_type == OP_RV2SV
+                || targetop->op_type == OP_AELEM
+                || targetop->op_type == OP_HELEM
+                )
+        )
+            return;
     }
     else if (   topop->op_type == OP_CONCAT
              && (topop->op_flags & OPf_STACKED)

diff --git a/t/op/concat2.t b/t/op/concat2.t
index 8e96299..a1cc0e6 100644 (file)
--- a/t/op/concat2.t
+++ b/t/op/concat2.t
@@ -12,7 +12,7 @@ BEGIN {
     set_up_inc('../lib');
 }
 
-plan 3;
+plan 4;
 
 # This test is in the file because overload.pm uses concatenation.
 { package o; use overload '""' => sub { $_[0][0] } }
@@ -57,3 +57,19 @@ fresh_perl_is <<'end', "tmp\ntmp\n", {},
  print canonpath(bless {},"Path::Class::Dir"), "\n";
 end
  "recursive concat does not share TARGs";
+
+# don't include the assign as part of the multiconcat if the target
+# includes 'local'. This used to screw up on magic vars because the
+# 'local $~' was done (thus emptying the var) before multiconcat was
+# called.
+
+
+{
+    local $~ = 'FOO';
+    my $s;
+    {
+        local $~ = "$~X";
+        $s = $~;
+    }
+    is($s, 'FOOX', 'local $magic_var = "...."');
+}

diff --git a/t/perf/opcount.t b/t/perf/opcount.t
index 2d0ade5..21a6f36 100644 (file)
--- a/t/perf/opcount.t
+++ b/t/perf/opcount.t
@@ -20,7 +20,7 @@ BEGIN {
 use warnings;
 use strict;
 
-plan 2582;
+plan 2583;
 
 use B ();
 
@@ -663,3 +663,15 @@ test_opcount(0, "multiconcat: 4 adjacent consts",
                     concat      => 0,
                     sassign     => 0,
                 });
+
+# multiconcat shouldn't include the assign if the LHS has 'local'
+
+test_opcount(0, "multiconcat: local assign",
+                sub { our $global; local $global = "$global-X" },
+                {
+                    const       => 0,
+                    gvsv        => 2,
+                    multiconcat => 1,
+                    concat      => 0,
+                    sassign     => 1,
+                });