diff options
author | Zefram <zefram@fysh.org> | 2009-09-27 14:42:11 +0200 |
---|---|---|
committer | Rafael Garcia-Suarez <rgs@consttype.org> | 2009-09-27 14:42:11 +0200 |
commit | 93e19c0f634ff075d96380394c4e3449389368d8 (patch) | |
tree | 7a430f687af4320300fe628219042a91e1cb8570 | |
parent | 338584c0b1c948a967b5e2ecbb69c512410589e4 (diff) | |
download | perl-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.pod | 6 | ||||
-rw-r--r-- | pp_sort.c | 6 | ||||
-rw-r--r-- | t/op/sort.t | 9 |
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 @@ -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"); |