in-place sort preserved element lvalue identity

RT #128340

The in-place sorting optimisation @a = sort @a, was preserving the
elements of @a rather than (logically) making copies. So make a copy
of any element whose refcount is greater than 1. This may not be the
perfect condition, but keeps performance for the common cases.

Note that several of the tests in t/op/sort.t actually relied on this
behaviour to test whether the sort was being in-placed, so I've added
tests for in-placing to t/perf/opcount.t instead.

See the previous commit for a general discussion of performance;
to the A, B, C in that commit message, here's a fourth column added:
D is like C but with this commit added:

                     A       B       C       D
                ------  ------  ------  ------
            Ir  5238.0  2324.0  2772.0  2801.0
            Dr  1464.0   649.0   765.0   765.0
            Dw   919.0   298.0   370.0   380.0
          COND   782.0   320.0   405.0   405.0
           IND    25.0    25.0    26.0    26.0

        COND_m    14.9    13.0    17.0    17.1
         IND_m     8.0     5.0     5.0     5.0

so it has little effect on performance.

3 files changed, 70 insertions, 9 deletions

diff --git a/pp_sort.c b/pp_sort.c
index e171411c4b..b68e80cd03 100644
--- a/pp_sort.c
+++ b/pp_sort.c
@@ -1760,8 +1760,14 @@ PP(pp_sort)
              * in the meantime. So bump and unbump the relevant refcounts
              * first.
              */
-            for (i = 0; i < max; i++)
-                SvREFCNT_inc_void(base[i]);
+            for (i = 0; i < max; i++) {
+                SV *sv = base[i];
+                assert(sv);
+                if (SvREFCNT(sv) > 1)
+                    base[i] = newSVsv(sv);
+                else
+                    SvREFCNT_inc_simple_void_NN(sv);
+            }
             av_clear(av);
             if (max > 0) {
                 av_extend(av, max);
diff --git a/t/op/sort.t b/t/op/sort.t
index 7a07b36010..cd1c6eb55f 100644
--- a/t/op/sort.t
+++ b/t/op/sort.t
@@ -7,7 +7,7 @@ BEGIN {
     set_up_inc('../lib');
 }
 use warnings;
-plan(tests => 195);
+plan(tests => 196);
 
 # these shouldn't hang
 {
@@ -417,21 +417,21 @@ cmp_ok($x,'eq','123',q(optimized-away comparison block doesn't take any other ar
     my ($r1,$r2,@a);
     our @g;
     @g = (3,2,1); $r1 = \$g[2]; @g = sort @g; $r2 = \$g[0];
-    is "$r1-@g", "$r2-1 2 3", "inplace sort of global";
+    is "$$r1-$$r2-@g", "1-1-1 2 3", "inplace sort of global";
 
     @a = qw(b a c); $r1 = \$a[1]; @a = sort @a; $r2 = \$a[0];
-    is "$r1-@a", "$r2-a b c", "inplace sort of lexical";
+    is "$$r1-$$r2-@a", "a-a-a b c", "inplace sort of lexical";
 
     @g = (2,3,1); $r1 = \$g[1]; @g = sort { $b <=> $a } @g; $r2 = \$g[0];
-    is "$r1-@g", "$r2-3 2 1", "inplace reversed sort of global";
+    is "$$r1-$$r2-@g", "3-3-3 2 1", "inplace reversed sort of global";
 
     @g = (2,3,1);
     $r1 = \$g[1]; @g = sort { $a<$b?1:$a>$b?-1:0 } @g; $r2 = \$g[0];
-    is "$r1-@g", "$r2-3 2 1", "inplace custom sort of global";
+    is "$$r1-$$r2-@g", "3-3-3 2 1", "inplace custom sort of global";
 
     sub mysort { $b cmp $a };
     @a = qw(b c a); $r1 = \$a[1]; @a = sort mysort @a; $r2 = \$a[0];
-    is "$r1-@a", "$r2-c b a", "inplace sort with function of lexical";
+    is "$$r1-$$r2-@a", "c-c-c b a", "inplace sort with function of lexical";
 
     use Tie::Array;
     my @t;
@@ -484,6 +484,15 @@ cmp_ok($x,'eq','123',q(optimized-away comparison block doesn't take any other ar
         is "@aa",   "a b c", "RT 39358 - aa";
         is "@copy", "b c a", "RT 39358 - copy";
     }
+
+    # RT #128340: in-place sort incorrectly preserves element lvalue identity
+
+    @a = (5, 4, 3);
+    my $r = \$a[2];
+    @a = sort { $a <=> $b } @a;
+    $$r = "z";
+    is ("@a", "3 4 5", "RT #128340");
+
 }
 
 # Test optimisations of reversed sorts. As we now guarantee stability by
diff --git a/t/perf/opcount.t b/t/perf/opcount.t
index 3cdd3342ee..f65695dc86 100644
--- a/t/perf/opcount.t
+++ b/t/perf/opcount.t
@@ -20,7 +20,7 @@ BEGIN {
 use warnings;
 use strict;
 
-plan 2251;
+plan 2256;
 
 use B ();
 
@@ -279,3 +279,49 @@ test_opcount(0, 'barewords can be constant-folded',
                      aelemfast_lex => 1,
                  });
 }
+
+# in-place sorting
+
+{
+    local our @global = (3,2,1);
+    my @lex = qw(a b c);
+
+    test_opcount(0, 'in-place sort of global',
+                 sub { @global = sort @global; 1 },
+                 {
+                     rv2av   => 1,
+                     aassign => 0,
+                 });
+
+    test_opcount(0, 'in-place sort of lexical',
+                 sub { @lex = sort @lex; 1 },
+                 {
+                     padav   => 1,
+                     aassign => 0,
+                 });
+
+    test_opcount(0, 'in-place reversed sort of global',
+                 sub { @global = sort { $b <=> $a } @global; 1 },
+                 {
+                     rv2av   => 1,
+                     aassign => 0,
+                 });
+
+
+    test_opcount(0, 'in-place custom sort of global',
+                 sub { @global = sort {  $a<$b?1:$a>$b?-1:0 } @global; 1 },
+                 {
+                     rv2av   => 1,
+                     aassign => 0,
+                 });
+
+    sub mysort { $b cmp $a };
+    test_opcount(0, 'in-place sort with function of lexical',
+                 sub { @lex = sort mysort @lex; 1 },
+                 {
+                     padav   => 1,
+                     aassign => 0,
+                 });
+
+
+}