Skip to content

Commit baccd98

Browse files
committed
sv_num*: correctly handle "0+" overloaded values
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
1 parent c1fe66b commit baccd98

File tree

4 files changed

+73
-7
lines changed

4 files changed

+73
-7
lines changed

ext/XS-APItest/t/sv_numcmp.t

Lines changed: 21 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
#!perl
22

3-
use Test::More tests => 17;
3+
use Test::More tests => 24;
44
use XS::APItest;
55
use Config;
66
use strict;
@@ -62,3 +62,23 @@ is sv_numcmp_flags($1, 10, SV_GMAGIC), 0, 'sv_numecmp_flags with SV_GMAGIC does'
6262
'AlwaysTen is not 10 with SV_SKIP_OVERLOAD';
6363
}
6464

65+
# +0 overloading with large numbers and using fallback
66+
{
67+
my $big = ~0;
68+
my $bigm1 = $big-1;
69+
package MyBigNum {
70+
use overload "0+" => sub { $_[0][0] },
71+
fallback => 1;
72+
}
73+
my $o1 = bless [ $big ], "MyBigNum";
74+
my $o2 = bless [ $big ], "MyBigNum";
75+
my $o3 = bless [ $bigm1 ], "MyBigNum";
76+
77+
is $o1 <=> $o2, 0, "perl op gets it right";
78+
is $o1 <=> $bigm1, 1, "perl op still gets it right for left overload";
79+
is $o1 <=> $o3, 1, "perl op still gets it right for different values";
80+
is sv_numcmp($o1, $o2), 0, "sv_numcmp two overloads";
81+
is sv_numcmp($o1, $o3), 1, "sv_numcmp two different overloads";
82+
is sv_numcmp($o1, $big), 0, "sv_numcmp left overload";
83+
is sv_numcmp($bigm1, $o3), 0, "sv_numcmp right overload";
84+
}

ext/XS-APItest/t/sv_numeq.t

Lines changed: 21 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
#!perl
22

3-
use Test::More tests => 15;
3+
use Test::More tests => 22;
44
use XS::APItest;
55
use Config;
66

@@ -47,4 +47,24 @@ ok sv_numeq_flags($1, 10, SV_GMAGIC), 'sv_numeq_flags with SV_GMAGIC does';
4747
ok !sv_numeq_flags($obj, 10, SV_SKIP_OVERLOAD), 'AlwaysTen is not 10 with SV_SKIP_OVERLOAD'
4848
}
4949

50+
# +0 overloading with large numbers and using fallback
51+
{
52+
my $big = ~0;
53+
my $bigm1 = $big-1;
54+
package MyBigNum {
55+
use overload "0+" => sub { $_[0][0] },
56+
fallback => 1;
57+
}
58+
my $o1 = bless [ $big ], "MyBigNum";
59+
my $o2 = bless [ $big ], "MyBigNum";
60+
my $o3 = bless [ $bigm1 ], "MyBigNum";
5061

62+
ok $o1 == $o2, "perl op gets it right";
63+
ok $o1 == $big, "perl op still gets it right for left overload";
64+
ok !($o1 == $o3), "perl op still gets it right for different values";
65+
ok sv_numeq($o1, $o2), "sv_numeq two overloads";
66+
ok !sv_numeq($o1, $o3), "sv_numeq two different overloads"
67+
or diag sprintf "%x vs %x", $o1, $o3;
68+
ok sv_numeq($o1, $big), "sv_numeq left overload";
69+
ok sv_numeq($bigm1, $o3), "sv_numeq right overload";
70+
}

ext/XS-APItest/t/sv_numne.t

Lines changed: 22 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
#!perl
22

3-
use Test::More tests => 15;
3+
use Test::More tests => 22;
44
use XS::APItest;
55
use Config;
66

@@ -45,3 +45,24 @@ ok !sv_numne_flags($1, 11, SV_GMAGIC), 'sv_numne_flags with SV_GMAGIC does';
4545

4646
ok !sv_numne_flags($obj, 11, SV_SKIP_OVERLOAD), 'AlwaysTwelve is 12 with SV_SKIP_OVERLOAD'
4747
}
48+
49+
# +0 overloading with large numbers and using fallback
50+
{
51+
my $big = ~0;
52+
my $bigm1 = $big-1;
53+
package MyBigNum {
54+
use overload "0+" => sub { $_[0][0] },
55+
fallback => 1;
56+
}
57+
my $o1 = bless [ $big ], "MyBigNum";
58+
my $o2 = bless [ $big ], "MyBigNum";
59+
my $o3 = bless [ $bigm1 ], "MyBigNum";
60+
61+
ok !($o1 != $o2), "perl op gets it right";
62+
ok $o1 != $bigm1, "perl op still gets it right for left overload";
63+
ok $o1 != $o3, "perl op still gets it right for different values";
64+
ok !sv_numne($o1, $o2), "sv_numne two overloads";
65+
ok sv_numne($o1, $o3), "sv_numne two different overloads";
66+
ok !sv_numne($o1, $big), "sv_numne left overload";
67+
ok !sv_numne($bigm1, $o3), "sv_numne right overload";
68+
}

sv.c

Lines changed: 9 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -8721,11 +8721,16 @@ S_sv_numcmp_common(pTHX_ SV **sv1, SV **sv2, const U32 flags,
87218721
if(!*sv2)
87228722
*sv2 = &PL_sv_undef;
87238723

8724-
/* FIXME: do_ncmp doesn't handle "+0" overloads well */
87258724
if(!(flags & SV_SKIP_OVERLOAD) &&
8726-
(SvAMAGIC(*sv1) || SvAMAGIC(*sv2)) &&
8727-
(*result = amagic_call(*sv1, *sv2, method, 0))) {
8728-
return true;
8725+
(SvAMAGIC(*sv1) || SvAMAGIC(*sv2))) {
8726+
if ((*result = amagic_call(*sv1, *sv2, method, 0)))
8727+
return true;
8728+
8729+
/* normally handled by try_amagic_bin */
8730+
if (SvROK(*sv1))
8731+
*sv1 = sv_2num(*sv1);
8732+
if (SvROK(*sv2))
8733+
*sv2 = sv_2num(*sv2);
87298734
}
87308735

87318736
return false;

0 commit comments

Comments
 (0)