summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorZefram <zefram@fysh.org>2009-09-27 14:42:11 +0200
committerRafael Garcia-Suarez <rgs@consttype.org>2009-09-27 14:42:11 +0200
commit93e19c0f634ff075d96380394c4e3449389368d8 (patch)
tree7a430f687af4320300fe628219042a91e1cb8570
parent338584c0b1c948a967b5e2ecbb69c512410589e4 (diff)
downloadperl-93e19c0f634ff075d96380394c4e3449389368d8.tar.gz
[perl #69384] numericness failure in sorting
This patch removes the error "Sort subroutine didn't return a numeric value" and adds a regression test.
-rw-r--r--pod/perldiag.pod6
-rw-r--r--pp_sort.c6
-rw-r--r--t/op/sort.t9
3 files changed, 8 insertions, 13 deletions
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 1f7bc0bc8e..026b68ec83 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 a27232f74b..4abec80ad4 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 616761a05d..8484827b6d 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");