In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/427fbfe878efea40f50caa8b0da22803460f50b0?hp=c9e7382961164fbbd62ade71269b59a2cfcc26aa>
- Log ----------------------------------------------------------------- commit 427fbfe878efea40f50caa8b0da22803460f50b0 Author: Tony Cook <[email protected]> Date: Wed Dec 14 14:24:08 2016 +1100 (perl #130335) fix numeric comparison for sort's built-in compare For non-'use integer' this would always compare as NVs, but with 64-bit integers and non-long doubles, integers can have more significant digits, making the sort <=> replacement less precise than the <=> operator. Use the same code to perform the comparison that <=> does, which happens to be handily broken out into Perl_do_ncmp(). ----------------------------------------------------------------------- Summary of changes: pp_sort.c | 12 ++++-------- t/lib/warnings/9uninit | 2 +- t/op/sort.t | 15 ++++++++++++++- 3 files changed, 19 insertions(+), 10 deletions(-) diff --git a/pp_sort.c b/pp_sort.c index 68e65f9f94..4ffe224842 100644 --- a/pp_sort.c +++ b/pp_sort.c @@ -1888,20 +1888,16 @@ S_sortcv_xsub(pTHX_ SV *const a, SV *const b) static I32 S_sv_ncmp(pTHX_ SV *const a, SV *const b) { - const NV nv1 = SvNSIV(a); - const NV nv2 = SvNSIV(b); + I32 cmp = do_ncmp(a, b); PERL_ARGS_ASSERT_SV_NCMP; -#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan) - if (Perl_isnan(nv1) || Perl_isnan(nv2)) { -#else - if (nv1 != nv1 || nv2 != nv2) { -#endif + if (cmp == 2) { if (ckWARN(WARN_UNINITIALIZED)) report_uninit(NULL); return 0; } - return nv1 < nv2 ? -1 : nv1 > nv2 ? 1 : 0; + + return cmp; } static I32 diff --git a/t/lib/warnings/9uninit b/t/lib/warnings/9uninit index c8b843f09a..77a93ced69 100644 --- a/t/lib/warnings/9uninit +++ b/t/lib/warnings/9uninit @@ -651,8 +651,8 @@ Use of uninitialized value $m1 in sort at - line 6. Use of uninitialized value $g1 in sort at - line 6. Use of uninitialized value $m1 in sort at - line 7. Use of uninitialized value $g1 in sort at - line 7. -Use of uninitialized value $m1 in sort at - line 7. Use of uninitialized value $g1 in sort at - line 7. +Use of uninitialized value $m1 in sort at - line 7. Use of uninitialized value $a in subtraction (-) at - line 8. Use of uninitialized value $b in subtraction (-) at - line 8. Use of uninitialized value $m1 in sort at - line 9. diff --git a/t/op/sort.t b/t/op/sort.t index cd1c6eb55f..96fad1c549 100644 --- a/t/op/sort.t +++ b/t/op/sort.t @@ -7,7 +7,7 @@ BEGIN { set_up_inc('../lib'); } use warnings; -plan(tests => 196); +plan(tests => 197); # these shouldn't hang { @@ -1147,3 +1147,16 @@ pass "no crash when sort block deletes *a and *b"; @a = sort { *a = sub { 1 }; $a <=> $b } 0 .. 1; ok(a(), "*a wasn't localized inadvertantly"); } + +SKIP: +{ + eval { require Config; 1 } + or skip "Cannot load Config", 1; + $Config::Config{ivsize} == 8 + or skip "this test can only fail with 64-bit integers", 1; + # sort's built-in numeric comparison wasn't careful enough in a world + # of integers with more significant digits than NVs + my @in = ( "0", "20000000000000001", "20000000000000000" ); + my @out = sort { $a <=> $b } @in; + is($out[1], "20000000000000000", "check sort order"); +} -- Perl5 Master Repository
