develooper Front page | perl.perl5.porters | Postings from April 2006

[PATCH] Prevent "use sort 'stable'" from reversing the order

Thread Next
From:
Robin Houston
Date:
April 2, 2006 09:20
Subject:
[PATCH] Prevent "use sort 'stable'" from reversing the order
Message ID:
20060402162024.GA3854@rpc142.cs.man.ac.uk
Sorry about this. It was a silly oversight, which went unnoticed
because of inadequate tests. Both those things are corrected by
the patch below.

Robin

--- lib/sort.t.orig	2006-04-02 16:46:08.000000000 +0100
+++ lib/sort.t	2006-04-02 17:16:54.000000000 +0100
@@ -26,7 +26,7 @@
 use warnings;
 
 use Test::More tests => @TestSizes * 2	# sort() tests
-			* 4		# number of pragmas to test
+			* 6		# number of pragmas to test
 			+ 1 		# extra test for qsort instability
 			+ 3		# tests for sort::current
 			+ 3;		# tests for "defaults" and "no sort"
@@ -163,16 +163,19 @@
     no sort qw(_qsort);
     my $sort_current; BEGIN { $sort_current = sort::current(); }
     is($sort_current, 'stable', 'sort::current after no _qsort');
+    main(sub { sort {&{$_[0]}} @{$_[1]} }, 0);
 }
 
 {
     use sort qw(defaults _qsort);
     my $sort_current; BEGIN { $sort_current = sort::current(); }
     is($sort_current, 'quicksort', 'sort::current after defaults _qsort');
+    # Not expected to be stable, so don't test for stability here
 }
 
 {
     use sort qw(defaults stable);
     my $sort_current; BEGIN { $sort_current = sort::current(); }
     is($sort_current, 'stable', 'sort::current after defaults stable');
+    main(sub { sort {&{$_[0]}} @{$_[1]} }, 0);
 }
--- pp_sort.c.orig	2006-04-02 16:50:37.000000000 +0100
+++ pp_sort.c	2006-04-02 17:12:14.000000000 +0100
@@ -363,7 +363,7 @@
 
     if (nmemb <= 1) return;			/* sorted trivially */
 
-    if (flags) {
+    if ((flags & SORTf_DESC) != 0) {
 	savecmp = PL_sort_RealCmp;	/* Save current comparison routine, if any */
 	PL_sort_RealCmp = cmp;	/* Put comparison routine where cmp_desc can find it */
 	cmp = cmp_desc;

Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About