From 44b9d16dc66e2eaf4606beffc64f9cba1f91fc3f Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Wed, 17 Dec 2025 10:37:42 +1100 Subject: [PATCH 1/3] sort: test numeric handling of optimized amagic ordering --- t/op/sort.t | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/t/op/sort.t b/t/op/sort.t index bdb965dcee63..e2011dfa51c9 100644 --- a/t/op/sort.t +++ b/t/op/sort.t @@ -7,7 +7,7 @@ BEGIN { set_up_inc('../lib'); } use warnings; -plan(tests => 205); +plan(tests => 206); use Tie::Array; # we need to test sorting tied arrays # these shouldn't hang @@ -964,6 +964,22 @@ is("@b", "1 2 3 3 4 5 7", "comparison result as string"); is($cs, 2, 'overload string called twice'); } +{ + # GH 23956 - amagic_ncmp didn't handle numeric conversions + # properly + package GH23956 { + use overload + fallback => 1, + "0+" => sub { $_[0][0] }; + } + my @data = map { + bless [ $_ ], "GH23956" + } ~0, ~0-1; + my @sorted = sort { $a <=> $b } @data; + local $::TODO = "sort amagic_ncmp is broken"; + is $sorted[0]+0, $data[1], "sort of 0+ overloaded values"; +} + fresh_perl_is('sub w ($$) {my ($l, $r) = @_; my $v = \@_; undef @_; $l <=> $r}; print join q{ }, sort w 3, 1, 2, 0', '0 1 2 3', {stderr => 1, switches => ['-w']}, From 6f1e2256e6bcb76529c12f8a65fa154f23ea5aaa Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Wed, 17 Dec 2025 11:03:21 +1100 Subject: [PATCH 2/3] sort: correctly sort "0+" overloaded values This also handles the theoretical case of large RVs, but I suspect it can't happen. Fixes #23956 --- embed.fnc | 4 ++-- pp_sort.c | 20 ++++++++++++++++---- proto.h | 2 +- t/op/sort.t | 1 - 4 files changed, 19 insertions(+), 8 deletions(-) diff --git a/embed.fnc b/embed.fnc index 7f10a3cd9261..148f9f48040d 100644 --- a/embed.fnc +++ b/embed.fnc @@ -5362,8 +5362,8 @@ i |I32 |sv_i_ncmp |NN SV * const a \ |NN SV * const b i |I32 |sv_i_ncmp_desc |NN SV * const a \ |NN SV * const b -i |I32 |sv_ncmp |NN SV * const a \ - |NN SV * const b +i |I32 |sv_ncmp |NN SV *a \ + |NN SV *b i |I32 |sv_ncmp_desc |NN SV * const a \ |NN SV * const b # if defined(USE_LOCALE_COLLATE) diff --git a/pp_sort.c b/pp_sort.c index de40b659e440..3a5918718458 100644 --- a/pp_sort.c +++ b/pp_sort.c @@ -1310,12 +1310,23 @@ S_sortcv_xsub(pTHX_ SV *const a, SV *const b) PERL_STATIC_FORCE_INLINE I32 -S_sv_ncmp(pTHX_ SV *const a, SV *const b) +S_sv_ncmp(pTHX_ SV *a, SV *b) { - I32 cmp = do_ncmp(a, b); - PERL_ARGS_ASSERT_SV_NCMP; + /* Numify since do_ncmp will just SvNV() non-IVs. + + Even for the non-overloading case, if RVs are allocated with + large 64-bit addresses (only theoretically possible I think) + the bottom bits of the RV might be lost. + */ + if (SvROK(a)) + a = sv_2num(a); + if (SvROK(b)) + b = sv_2num(b); + + I32 cmp = do_ncmp(a, b); + if (cmp == 2) { if (ckWARN(WARN_UNINITIALIZED)) report_uninit(NULL); return 0; @@ -1359,7 +1370,7 @@ S_sv_i_ncmp_desc(pTHX_ SV *const a, SV *const b) #define SORT_NORMAL_RETURN_VALUE(val) (((val) > 0) ? 1 : ((val) ? -1 : 0)) PERL_STATIC_FORCE_INLINE I32 -S_amagic_ncmp(pTHX_ SV *const a, SV *const b) +S_amagic_ncmp(pTHX_ SV *a, SV *b) { SV * const tmpsv = tryCALL_AMAGICbin(a,b,ncmp_amg); @@ -1375,6 +1386,7 @@ S_amagic_ncmp(pTHX_ SV *const a, SV *const b) return SORT_NORMAL_RETURN_VALUE(d); } } + return S_sv_ncmp(aTHX_ a, b); } diff --git a/proto.h b/proto.h index 95eb1aa7d501..00b088544081 100644 --- a/proto.h +++ b/proto.h @@ -8193,7 +8193,7 @@ S_sv_i_ncmp_desc(pTHX_ SV * const a, SV * const b); assert(a); assert(b) PERL_STATIC_INLINE I32 -S_sv_ncmp(pTHX_ SV * const a, SV * const b); +S_sv_ncmp(pTHX_ SV *a, SV *b); # define PERL_ARGS_ASSERT_SV_NCMP \ assert(a); assert(b) diff --git a/t/op/sort.t b/t/op/sort.t index e2011dfa51c9..cdc050f42221 100644 --- a/t/op/sort.t +++ b/t/op/sort.t @@ -976,7 +976,6 @@ is("@b", "1 2 3 3 4 5 7", "comparison result as string"); bless [ $_ ], "GH23956" } ~0, ~0-1; my @sorted = sort { $a <=> $b } @data; - local $::TODO = "sort amagic_ncmp is broken"; is $sorted[0]+0, $data[1], "sort of 0+ overloaded values"; } From 9eafc074fee4d5a6462e04f1e4dd64388b97bba7 Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Wed, 17 Dec 2025 15:11:17 +1100 Subject: [PATCH 3/3] perldelta for sort of overloaded numbers fix --- pod/perldelta.pod | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/pod/perldelta.pod b/pod/perldelta.pod index b3cc104a1ae8..bf713144ce1d 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -386,7 +386,13 @@ manager will later use a regex to expand these into links. =item * -XXX +sort() optimizes well known comparisons from calling the OP tree for a +comparison block into a call to a C function. The C function used for +overloaded numeric comparisons did not handle the case where there was +no comparison overload but there was a numeric ("0+") overload +correct, losing precision for large overloaded integer arguments that +are not exactly representable as a Perl floating point value (NV). +[GH #23956] =back