mirror/perl
1
0
Fork 0
mirror of https://github.com/Perl/perl5.git synced 2026-01-26 08:38:23 +00:00
Code Issues Packages Projects Releases Wiki Activity

sv_num*: correctly handle "0+" overloaded values

Browse Source 
do_ncmp() expects simple SVs and for overloaded SVs will just compare
the SvNV() of each SV, mishandling the case where the 0+ overload
returns a large UV or IV that isn't exactly representable as an NV.

# Conflicts:
#	ext/XS-APItest/t/sv_numeq.t
#	ext/XS-APItest/t/sv_numne.t
#	sv.c
This commit is contained in:
Tony Cook 2025-11-26 14:36:41 +11:00
parent 01e16d6bee
commit 897c610479
4 changed files with 73 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
ext/XS-APItest/t/sv_numcmp.t
View File

@ -1,6 +1,6 @@
#!perl
use Test::More tests => 17;
use Test::More tests => 24;
use XS::APItest;
use Config;
use strict;
@ -63,3 +63,23 @@ is sv_numcmp_flags($1, 10, SV_GMAGIC), 0, 'sv_numcmp_flags with SV_GMAGIC does';
'AlwaysTen is not 10 with SV_SKIP_OVERLOAD';
}
# +0 overloading with large numbers and using fallback
{
my $big = ~0;
my $bigm1 = $big-1;
package MyBigNum {
use overload "0+" => sub { $_[0][0] },
fallback => 1;
}
my $o1 = bless [ $big ], "MyBigNum";
my $o2 = bless [ $big ], "MyBigNum";
my $o3 = bless [ $bigm1 ], "MyBigNum";
is $o1 <=> $o2, 0, "perl op gets it right";
is $o1 <=> $bigm1, 1, "perl op still gets it right for left overload";
is $o1 <=> $o3, 1, "perl op still gets it right for different values";
is sv_numcmp($o1, $o2), 0, "sv_numcmp two overloads";
is sv_numcmp($o1, $o3), 1, "sv_numcmp two different overloads";
is sv_numcmp($o1, $big), 0, "sv_numcmp left overload";
is sv_numcmp($bigm1, $o3), 0, "sv_numcmp right overload";
}

22
ext/XS-APItest/t/sv_numeq.t
View File

@ -1,6 +1,6 @@
#!perl
use Test::More tests => 15;
use Test::More tests => 22;
use XS::APItest;
use Config;
@ -49,4 +49,24 @@ ok sv_numeq_flags($1, 10, SV_GMAGIC), 'sv_numeq_flags with SV_GMAGIC does';
ok !sv_numeq_flags($obj, 10, SV_SKIP_OVERLOAD), 'AlwaysTen is not 10 with SV_SKIP_OVERLOAD'
}
# +0 overloading with large numbers and using fallback
{
my $big = ~0;
my $bigm1 = $big-1;
package MyBigNum {
use overload "0+" => sub { $_[0][0] },
fallback => 1;
}
my $o1 = bless [ $big ], "MyBigNum";
my $o2 = bless [ $big ], "MyBigNum";
my $o3 = bless [ $bigm1 ], "MyBigNum";
ok $o1 == $o2, "perl op gets it right";
ok $o1 == $big, "perl op still gets it right for left overload";
ok !($o1 == $o3), "perl op still gets it right for different values";
ok sv_numeq($o1, $o2), "sv_numeq two overloads";
ok !sv_numeq($o1, $o3), "sv_numeq two different overloads"
or diag sprintf "%x vs %x", $o1, $o3;
ok sv_numeq($o1, $big), "sv_numeq left overload";
ok sv_numeq($bigm1, $o3), "sv_numeq right overload";
}

23
ext/XS-APItest/t/sv_numne.t
View File

@ -1,6 +1,6 @@
#!perl
use Test::More tests => 15;
use Test::More tests => 22;
use XS::APItest;
use Config;
@ -46,3 +46,24 @@ ok !sv_numne_flags($1, 11, SV_GMAGIC), 'sv_numne_flags with SV_GMAGIC does';
ok !sv_numne_flags($obj, 11, SV_SKIP_OVERLOAD), 'AlwaysTwelve is 12 with SV_SKIP_OVERLOAD'
}
# +0 overloading with large numbers and using fallback
{
my $big = ~0;
my $bigm1 = $big-1;
package MyBigNum {
use overload "0+" => sub { $_[0][0] },
fallback => 1;
}
my $o1 = bless [ $big ], "MyBigNum";
my $o2 = bless [ $big ], "MyBigNum";
my $o3 = bless [ $bigm1 ], "MyBigNum";
ok !($o1 != $o2), "perl op gets it right";
ok $o1 != $bigm1, "perl op still gets it right for left overload";
ok $o1 != $o3, "perl op still gets it right for different values";
ok !sv_numne($o1, $o2), "sv_numne two overloads";
ok sv_numne($o1, $o3), "sv_numne two different overloads";
ok !sv_numne($o1, $big), "sv_numne left overload";
ok !sv_numne($bigm1, $o3), "sv_numne right overload";
}

13
sv.c
View File

@ -8715,11 +8715,16 @@ S_sv_numcmp_common(pTHX_ SV **sv1, SV **sv2, const U32 flags,
if(!*sv2)
*sv2 = &PL_sv_undef;
/* FIXME: do_ncmp doesn't handle "+0" overloads well */
if(!(flags & SV_SKIP_OVERLOAD) &&
(SvAMAGIC(*sv1) || SvAMAGIC(*sv2)) &&
(*result = amagic_call(*sv1, *sv2, method, 0))) {
return true;
(SvAMAGIC(*sv1) || SvAMAGIC(*sv2))) {
if ((*result = amagic_call(*sv1, *sv2, method, 0)))
return true;
/* normally handled by try_amagic_bin */
if (SvROK(*sv1))
*sv1 = sv_2num(*sv1);
if (SvROK(*sv2))
*sv2 = sv_2num(*sv2);
}
return false;