in-place sort preserved element lvalue identity
authorDavid Mitchell <davem@iabyn.com>
Wed, 10 Aug 2016 15:19:55 +0000 (16:19 +0100)
committerDavid Mitchell <davem@iabyn.com>
Wed, 10 Aug 2016 15:34:04 +0000 (16:34 +0100)
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.

pp_sort.c
t/op/sort.t
t/perf/opcount.t

index e171411..b68e80c 100644 (file)
--- 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);
index 7a07b36..cd1c6eb 100644 (file)
@@ -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
index 3cdd334..f65695d 100644 (file)
@@ -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,
+                 });
+
+
+}