make my (...) = @_ non-OPpASSIGN_COMMON_RC1

Technically in

    my ($scalar,...) = @_

due to closure/goto tricks, its possible for $scalar to appear on both
the LHS and RHS, so we currently set the OPpASSIGN_COMMON_RC1 flag.

However, this imposes extra overhead; for example 5% extra instruction
reads and 11% extra conditional branches for

    my ($x,$y,$z) = @_;

Given what an important construct this is, disable this flag in the
specific case of of only my's on the LHS and only @_ on the RHS.
It's technically incorrect, but its the same behaviour we've always had
(it was only the previous commit which made it safe but slower).

We still set the OPpASSIGN_COMMON_AGG flag for

    my ($...,@a) = @_

since in the normal case this only adds the small additional runtime
overhead of checking that @a is already empty.

2 files changed, 25 insertions, 2 deletions

diff --git a/t/op/aassign.t b/t/op/aassign.t
index 622053c004..3d1ae425cd 100644
--- a/t/op/aassign.t
+++ b/t/op/aassign.t
@@ -262,4 +262,27 @@ sub sh {
     is("$a16:$b16", "1:3", "surplus RHS junk");
 }
 
+# my ($scalar,....) = @_
+#
+# technically this is an unsafe usage commonality-wise, but
+# a) you have to try really hard to break it, as this test shows;
+# b) it's such an important usage that for performance reasons we
+#    mark it as safe even though it isn't really. Hence it's a TODO.
+
+{
+    local $::TODO = 'cheat and optimise my (....) = @_';
+    local @_ = 1..3;
+    &f17;
+    my ($a, @b) = @_;
+    is("($a)(@b)", "(3)(2 1)", 'my (....) = @_');
+
+    sub f17 {
+        use feature 'refaliasing';
+        no warnings 'experimental';
+        ($a, @b) = @_;
+        \($_[2], $_[1], $_[0]) = \($a, $b[0], $b[1]);
+    }
+}
+
+
 done_testing();
diff --git a/t/perf/optree.t b/t/perf/optree.t
index 40d2091ac7..4b53aeffd5 100644
--- a/t/perf/optree.t
+++ b/t/perf/optree.t
@@ -50,8 +50,8 @@ for my $test (
     [ "---", '($x,$y) = (1,2)', 'pkg var LHS only' ],
     [ "---", 'my $p; my ($x,$y) = ($p, $p)', 'my; dup lex var on RHS' ],
     [ "---", 'my $p; my ($x,$y); ($x,$y) = ($p, $p)', 'dup lex var on RHS' ],
-    [ "-R-", 'my ($self) = @_', 'LHS lex scalar only' ],
-    [ "-RA", 'my ($self, @rest) = @_', 'LHS lex mixed' ],
+    [ "---", 'my ($self) = @_', 'LHS lex scalar only' ],
+    [ "--A", 'my ($self, @rest) = @_', 'LHS lex mixed' ],
     [ "-R-", 'my ($x,$y) = ($p, $q)', 'pkg var RHS only' ],
     [ "S--", '($x,$y) = ($p, $q)', 'pkg scalar both sides' ],
     [ "--A", 'my (@a, @b); @a = @b', 'lex ary both sides' ],