summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorTony Cook <tony@develop-help.com>2016-12-14 14:24:08 +1100
committerJames E Keenan <jkeenan@cpan.org>2016-12-23 08:13:34 -0500
commit427fbfe878efea40f50caa8b0da22803460f50b0 (patch)
tree73768dcc97c1c4cea186dda2e0966d344c8133e6
parentc9e7382961164fbbd62ade71269b59a2cfcc26aa (diff)
downloadperl-427fbfe878efea40f50caa8b0da22803460f50b0.tar.gz
(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().
-rw-r--r--pp_sort.c12
-rw-r--r--t/lib/warnings/9uninit2
-rw-r--r--t/op/sort.t15
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");
+}