From: Zefram <zefram@fysh.org>
Date: Sun, 27 Sep 2009 12:42:11 +0000 (+0200)
Subject: [perl #69384] numericness failure in sorting
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=93e19c0f634ff075d96380394c4e3449389368d8;p=p5sagit%2Fp5-mst-13.2.git

[perl #69384] numericness failure in sorting

This patch removes the error "Sort subroutine didn't return a numeric
value" and adds a regression test.
---

diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 1f7bc0b..026b68e 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -3920,12 +3920,6 @@ the smart match.
 (F) An ancient error message that almost nobody ever runs into anymore.
 But before sort was a keyword, people sometimes used it as a filehandle.
 
-=item Sort subroutine didn't return a numeric value
-
-(F) A sort comparison routine must return a number.  You probably blew
-it by not using C<< <=> >> or C<cmp>, or by not using them correctly.
-See L<perlfunc/sort>.
-
 =item Sort subroutine didn't return single value
 
 (F) A sort comparison subroutine may not return a list value with more
diff --git a/pp_sort.c b/pp_sort.c
index a27232f..4abec80 100644
--- a/pp_sort.c
+++ b/pp_sort.c
@@ -1757,8 +1757,6 @@ S_sortcv(pTHX_ SV *const a, SV *const b)
     CALLRUNOPS(aTHX);
     if (PL_stack_sp != PL_stack_base + 1)
 	Perl_croak(aTHX_ "Sort subroutine didn't return single value");
-    if (!SvNIOKp(*PL_stack_sp))
-	Perl_croak(aTHX_ "Sort subroutine didn't return a numeric value");
     result = SvIV(*PL_stack_sp);
     while (PL_scopestack_ix > oldscopeix) {
 	LEAVE;
@@ -1799,8 +1797,6 @@ S_sortcv_stacked(pTHX_ SV *const a, SV *const b)
     CALLRUNOPS(aTHX);
     if (PL_stack_sp != PL_stack_base + 1)
 	Perl_croak(aTHX_ "Sort subroutine didn't return single value");
-    if (!SvNIOKp(*PL_stack_sp))
-	Perl_croak(aTHX_ "Sort subroutine didn't return a numeric value");
     result = SvIV(*PL_stack_sp);
     while (PL_scopestack_ix > oldscopeix) {
 	LEAVE;
@@ -1829,8 +1825,6 @@ S_sortcv_xsub(pTHX_ SV *const a, SV *const b)
     (void)(*CvXSUB(cv))(aTHX_ cv);
     if (PL_stack_sp != PL_stack_base + 1)
 	Perl_croak(aTHX_ "Sort subroutine didn't return single value");
-    if (!SvNIOKp(*PL_stack_sp))
-	Perl_croak(aTHX_ "Sort subroutine didn't return a numeric value");
     result = SvIV(*PL_stack_sp);
     while (PL_scopestack_ix > oldscopeix) {
 	LEAVE;
diff --git a/t/op/sort.t b/t/op/sort.t
index 616761a..8484827 100644
--- a/t/op/sort.t
+++ b/t/op/sort.t
@@ -6,7 +6,7 @@ BEGIN {
     require 'test.pl';
 }
 use warnings;
-plan( tests => 144 );
+plan( tests => 146 );
 
 # these shouldn't hang
 {
@@ -801,3 +801,10 @@ is("@b", "10 9 8 7 6 5 4 3 2 1", "return with SVs on stack");
 sub ret_with_stacked { $_ = ($a<=>$b) + do {return $b <=> $a} }
 @b = sort ret_with_stacked 1..10;
 is("@b", "10 9 8 7 6 5 4 3 2 1", "return with SVs on stack");
+
+# Comparison code should be able to give result in non-integer representation.
+sub cmp_as_string($$) { $_[0] < $_[1] ? "-1" : $_[0] == $_[1] ? "0" : "+1" }
+@b = sort { cmp_as_string($a, $b) } (1,5,4,7,3,2,3);
+is("@b", "1 2 3 3 4 5 7", "comparison result as string");
+@b = sort cmp_as_string (1,5,4,7,3,2,3);
+is("@b", "1 2 3 3 4 5 7", "comparison result as string");