From: Rafael Garcia-Suarez <rgarciasuarez@gmail.com>
Date: Thu, 18 Nov 2004 17:25:19 +0000 (+0000)
Subject: Fix deparsing of reversed sort and descending sorts,
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3ac6e0f94cbac2937b08ea7ee5d77e4a19c63780;p=p5sagit%2Fp5-mst-13.2.git

Fix deparsing of reversed sort and descending sorts,
due to the recent optimisations on this part of the optree.

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

diff --git a/ext/B/B/Deparse.pm b/ext/B/B/Deparse.pm
index 6071af8..e3ce213 100644
--- a/ext/B/B/Deparse.pm
+++ b/ext/B/B/Deparse.pm
@@ -14,12 +14,12 @@ use B qw(class main_root main_start main_cv svref_2object opnumber perlstring
 	 OPpLVAL_INTRO OPpOUR_INTRO OPpENTERSUB_AMPER OPpSLICE OPpCONST_BARE
 	 OPpTRANS_SQUASH OPpTRANS_DELETE OPpTRANS_COMPLEMENT OPpTARGET_MY
 	 OPpCONST_ARYBASE OPpEXISTS_SUB OPpSORT_NUMERIC OPpSORT_INTEGER
-	 OPpSORT_REVERSE OPpSORT_INPLACE
+	 OPpSORT_REVERSE OPpSORT_INPLACE OPpSORT_DESCEND
 	 SVf_IOK SVf_NOK SVf_ROK SVf_POK SVpad_OUR SVf_FAKE SVs_RMG SVs_SMG
          CVf_METHOD CVf_LOCKED CVf_LVALUE CVf_ASSERTION
 	 PMf_KEEP PMf_GLOBAL PMf_CONTINUE PMf_EVAL PMf_ONCE PMf_SKIPWHITE
 	 PMf_MULTILINE PMf_SINGLELINE PMf_FOLD PMf_EXTENDED);
-$VERSION = 0.68;
+$VERSION = 0.69;
 use strict;
 use vars qw/$AUTOLOAD/;
 use warnings ();
@@ -2303,18 +2303,22 @@ sub indirop {
 	$kid = $kid->sibling;
     }
     if ($name eq "sort" && $op->private & (OPpSORT_NUMERIC | OPpSORT_INTEGER)) {
-	$indir = ($op->private & OPpSORT_REVERSE) ? '{$b <=> $a} '
+	$indir = ($op->private & OPpSORT_DESCEND) ? '{$b <=> $a} '
 						  : '{$a <=> $b} ';
     }
-    elsif ($name eq "sort" && $op->private & OPpSORT_REVERSE) {
+    elsif ($name eq "sort" && $op->private & OPpSORT_DESCEND) {
 	$indir = '{$b cmp $a} ';
     }
     for (; !null($kid); $kid = $kid->sibling) {
 	$expr = $self->deparse($kid, 6);
 	push @exprs, $expr;
     }
+    my $name2 = $name;
+    if ($name eq "sort" && $op->private & OPpSORT_REVERSE) {
+	$name2 = 'reverse sort';
+    }
     if ($name eq "sort" && ($op->private & OPpSORT_INPLACE)) {
-	return "$exprs[0] = sort $indir $exprs[0]";
+	return "$exprs[0] = $name2 $indir $exprs[0]";
     }
 
     my $args = $indir . join(", ", @exprs);
@@ -2326,12 +2330,12 @@ sub indirop {
 	# neccessary more often that they really are, because we don't
 	# distinguish which side of an assignment we're on.
 	if ($cx >= 5) {
-	    return "($name $args)";
+	    return "($name2 $args)";
 	} else {
-	    return "$name $args";
+	    return "$name2 $args";
 	}
     } else {
-	return $self->maybe_parens_func($name, $args, $cx, 5);
+	return $self->maybe_parens_func($name2, $args, $cx, 5);
     }
 
 }
@@ -2396,7 +2400,12 @@ sub pp_list {
 			&& $lop->first->private & OPpOUR_INTRO) { # our()
 	    ($local = "", last) if $local eq "my" || $local eq "local";
 	    $local = "our";
-	} elsif ($lop->name ne "undef") { # local()
+	} elsif ($lop->name ne "undef"
+		# specifically avoid the "reverse sort" optimisation,
+		# where "reverse" is nullified
+		&& !($lop->name eq 'sort' && ($lop->flags | OPpSORT_REVERSE)))
+	{
+	    # local()
 	    ($local = "", last) if $local eq "my" || $local eq "our";
 	    $local = "local";
 	}
diff --git a/ext/B/t/deparse.t b/ext/B/t/deparse.t
index fed9cf0..6c5bcb9 100644
--- a/ext/B/t/deparse.t
+++ b/ext/B/t/deparse.t
@@ -20,7 +20,7 @@ use warnings;
 use strict;
 use Config;
 
-print "1..32\n";
+print "1..35\n";
 
 use B::Deparse;
 my $deparse = B::Deparse->new() or print "not ";
@@ -265,3 +265,15 @@ my $i;
 foreach our $i (1, 2) {
     my $z = 1;
 }
+####
+# 29
+my @x;
+print reverse sort(@x);
+####
+# 30
+my @x;
+print((sort {$b cmp $a} @x));
+####
+# 31
+my @x;
+print((reverse sort {$b <=> $a} @x));