(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().

diff --git a/pp_sort.c b/pp_sort.c
index 68e65f9..4ffe224 100644 (file)
--- 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 c8b843f..77a93ce 100644 (file)
--- 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 cd1c6eb..96fad1c 100644 (file)
--- 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");
+}