From: Dave Mitchell <davem@fdisolutions.com>
Date: Sat, 22 May 2004 11:15:34 +0000 (+0000)
Subject:  [perl #29790] Optimization busted: '@a = "b", sort @a' drops "b"
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=db7511dbe8b6c31eca42cd71bbe3853dbf1d748b;p=p5sagit%2Fp5-mst-13.2.git

 [perl #29790] Optimization busted: '@a = "b", sort @a' drops "b"
 Fix the sort-in-place optimization of change #22349.
p4raw-link: @22349 on //depot/perl: fe1bc4cf71e7b04d33e679798964a090d9fa7b46

p4raw-id: //depot/perl@22839
---

diff --git a/op.c b/op.c
index bdc3426..cdc0749 100644
--- a/op.c
+++ b/op.c
@@ -6642,6 +6642,17 @@ Perl_peep(pTHX_ register OP *o)
 		    || (o2->op_flags & OPf_WANT) != OPf_WANT_VOID)
 		break;
 
+	    /* check that the sort is the first arg on RHS of assign */
+
+	    o2 = cUNOPx(o2)->op_first;
+	    if (!o2 || o2->op_type != OP_NULL)
+		break;
+	    o2 = cUNOPx(o2)->op_first;
+	    if (!o2 || o2->op_type != OP_PUSHMARK)
+		break;
+	    if (o2->op_sibling != o)
+		break;
+
 	    /* check the array is the same on both sides */
 	    if (oleft->op_type == OP_RV2AV) {
 		if (oright->op_type != OP_RV2AV
diff --git a/t/op/sort.t b/t/op/sort.t
index a218e97..c1129c2 100755
--- a/t/op/sort.t
+++ b/t/op/sort.t
@@ -5,7 +5,7 @@ BEGIN {
     @INC = '../lib';
 }
 use warnings;
-print "1..65\n";
+print "1..75\n";
 
 # these shouldn't hang
 {
@@ -354,13 +354,41 @@ sub ok {
     ok "$r1-@a", "$r2-c b a", "inplace sort with function of lexical";
 
     use Tie::Array;
-    tie @a, 'Tie::StdArray';
+    my @t;
+    tie @t, 'Tie::StdArray';
 
-    @a = qw(b c a); @a = sort @a;
-    ok "@a", "a b c", "inplace sort of tied array";
+    @t = qw(b c a); @t = sort @t;
+    ok "@t", "a b c", "inplace sort of tied array";
 
-    @a = qw(b c a); @a = sort mysort @a;
-    ok "@a", "c b a", "inplace sort of tied array with function";
+    @t = qw(b c a); @t = sort mysort @t;
+    ok "@t", "c b a", "inplace sort of tied array with function";
+
+    #  [perl #29790] don't optimise @a = ('a', sort @a) !
+
+    @g = (3,2,1); @g = ('0', sort @g);
+    ok "@g", "0 1 2 3", "un-inplace sort of global";
+    @g = (3,2,1); @g = (sort(@g),'4');
+    ok "@g", "1 2 3 4", "un-inplace sort of global 2";
+
+    @a = qw(b a c); @a = ('x', sort @a);
+    ok "@a", "x a b c", "un-inplace sort of lexical";
+    @a = qw(b a c); @a = ((sort @a), 'x');
+    ok "@a", "a b c x", "un-inplace sort of lexical 2";
+
+    @g = (2,3,1); @g = ('0', sort { $b <=> $a } @g);
+    ok "@g", "0 3 2 1", "un-inplace reversed sort of global";
+    @g = (2,3,1); @g = ((sort { $b <=> $a } @g),'4');
+    ok "@g", "3 2 1 4", "un-inplace reversed sort of global 2";
+
+    @g = (2,3,1); @g = ('0', sort { $a<$b?1:$a>$b?-1:0 } @g);
+    ok "@g", "0 3 2 1", "un-inplace custom sort of global";
+    @g = (2,3,1); @g = ((sort { $a<$b?1:$a>$b?-1:0 } @g),'4');
+    ok "@g", "3 2 1 4", "un-inplace custom sort of global 2";
+
+    @a = qw(b c a); @a = ('x', sort mysort @a);
+    ok "@a", "x c b a", "un-inplace sort with function of lexical";
+    @a = qw(b c a); @a = ((sort mysort @a),'x');
+    ok "@a", "c b a x", "un-inplace sort with function of lexical 2";
 }