Skip to content

Commit 6f1ca3f

Browse files
tonycoztonycoz
committed
add sv_numne() to the API
some refactoring next, since sv_numeq_flags and sv_numne_flags are similar. Used a separate test file since putting every sv_num*() variant in the one file would be ugly Addresses GH Perl#23918 but isn't a direct fix
1 parent dd8309d commit 6f1ca3f

10 files changed

Lines changed: 119 additions & 3 deletions

File tree

‎MANIFEST‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -5192,6 +5192,7 @@ ext/XS-APItest/t/stuff_svcur_bug.t test for a bug in lex_stuff_pvn
51925192
ext/XS-APItest/t/subcall.t Test XSUB calls
51935193
ext/XS-APItest/t/subsignature.t Test parse_subsignature()
51945194
ext/XS-APItest/t/sv_numeq.t Test sv_numeq
5195+
ext/XS-APItest/t/sv_numne.t Test sv_numne
51955196
ext/XS-APItest/t/sv_streq.t Test sv_streq
51965197
ext/XS-APItest/t/svcat.t Test sv_catpvn
51975198
ext/XS-APItest/t/svcatpvf.t Test sv_catpvf argument reordering

‎embed.fnc‎

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -3419,6 +3419,11 @@ Admp |bool |sv_numeq |NULLOK SV *sv1 \
34193419
Adp |bool |sv_numeq_flags |NULLOK SV *sv1 \
34203420
|NULLOK SV *sv2 \
34213421
|const U32 flags
3422+
Admp |bool |sv_numne |NULLOK SV *sv1 \
3423+
|NULLOK SV *sv2
3424+
Adp |bool |sv_numne_flags |NULLOK SV *sv1 \
3425+
|NULLOK SV *sv2 \
3426+
|const U32 flags
34223427
Adip |NV |SvNV |NN SV *sv
34233428
Adp |NV |sv_2nv_flags |NN SV * const sv \
34243429
|const I32 flags

‎embed.h‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -727,6 +727,7 @@
727727
# define sv_newref(a) Perl_sv_newref(aTHX_ a)
728728
# define sv_nosharing(a) Perl_sv_nosharing(aTHX_ a)
729729
# define sv_numeq_flags(a,b,c) Perl_sv_numeq_flags(aTHX_ a,b,c)
730+
# define sv_numne_flags(a,b,c) Perl_sv_numne_flags(aTHX_ a,b,c)
730731
# define sv_peek(a) Perl_sv_peek(aTHX_ a)
731732
# define sv_pos_b2u(a,b) Perl_sv_pos_b2u(aTHX_ a,b)
732733
# define sv_pos_b2u_flags(a,b,c) Perl_sv_pos_b2u_flags(aTHX_ a,b,c)
@@ -2345,6 +2346,7 @@
23452346
# define Perl_sv_insert(mTHX,a,b,c,d,e) sv_insert(a,b,c,d,e)
23462347
# define Perl_sv_mortalcopy(mTHX,a) sv_mortalcopy(a)
23472348
# define Perl_sv_numeq(mTHX,a,b) sv_numeq(a,b)
2349+
# define Perl_sv_numne(mTHX,a,b) sv_numne(a,b)
23482350
# define Perl_sv_pv(mTHX,a) sv_pv(a)
23492351
# define Perl_sv_pvbyte(mTHX,a) sv_pvbyte(a)
23502352
# define Perl_sv_pvn_force(mTHX,a,b) sv_pvn_force(a,b)
@@ -2446,6 +2448,7 @@
24462448
# define Perl_sv_insert sv_insert
24472449
# define Perl_sv_mortalcopy sv_mortalcopy
24482450
# define Perl_sv_numeq sv_numeq
2451+
# define Perl_sv_numne sv_numne
24492452
# define Perl_sv_pv sv_pv
24502453
# define Perl_sv_pvbyte sv_pvbyte
24512454
# define Perl_sv_pvn_force sv_pvn_force

‎ext/XS-APItest/APItest.pm‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,7 @@ use strict;
44
use warnings;
55
use Carp;
66

7-
our $VERSION = '1.47';
7+
our $VERSION = '1.48';
88

99
require XSLoader;
1010

‎ext/XS-APItest/APItest.xs‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -5020,6 +5020,12 @@ sv_numeq_flags(SV *sv1, SV *sv2, U32 flags)
50205020
OUTPUT:
50215021
RETVAL
50225022

5023+
bool
5024+
sv_numne(SV *sv1, SV *sv2)
5025+
5026+
bool
5027+
sv_numne_flags(SV *sv1, SV *sv2, U32 flags)
5028+
50235029
bool
50245030
sv_streq(SV *sv1, SV *sv2)
50255031
CODE:

‎ext/XS-APItest/t/sv_numeq.t‎

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

3-
use Test::More tests => 9;
3+
use Test::More tests => 11;
44
use XS::APItest;
55

66
my $four = 4;
@@ -9,7 +9,7 @@ ok !sv_numeq($four, 5), '$four != 5';
99

1010
my $six_point_five = 6.5; # an exact float, so == is fine
1111
ok sv_numeq($six_point_five, 6.5), '$six_point_five == 6.5';
12-
ok !sv_numeq($six_point_five, 6.6), '$six_point_five == 6.6';
12+
ok !sv_numeq($six_point_five, 6.6), '$six_point_five != 6.6';
1313

1414
# GMAGIC
1515
"10" =~ m/(\d+)/;
@@ -27,6 +27,10 @@ ok sv_numeq_flags($1, 10, SV_GMAGIC), 'sv_numeq_flags with SV_GMAGIC does';
2727

2828
ok sv_numeq($obj, 10), 'AlwaysTen is 10';
2929
ok !sv_numeq($obj, 11), 'AlwaysTen is not 11';
30+
ok sv_numeq(10, $obj), 'AlwaysTen is 10 on the right';
31+
ok !sv_numeq(11, $obj), 'AlwaysTen is not 11 on the right';
3032

3133
ok !sv_numeq_flags($obj, 10, SV_SKIP_OVERLOAD), 'AlwaysTen is not 10 with SV_SKIP_OVERLOAD'
3234
}
35+
36+

‎ext/XS-APItest/t/sv_numne.t‎

Lines changed: 35 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,35 @@
1+
#!perl
2+
3+
use Test::More tests => 11;
4+
use XS::APItest;
5+
6+
my $four = 4;
7+
ok !sv_numne($four, 4), '$four != 4';
8+
ok sv_numne($four, 5), '$four == 5';
9+
10+
my $six_point_five = 6.5; # an exact float, so == is fine
11+
ok !sv_numne($six_point_five, 6.5), '$six_point_five == 6.5';
12+
ok sv_numne($six_point_five, 6.6), '$six_point_five != 6.6';
13+
14+
# GMAGIC
15+
"11" =~ m/(\d+)/;
16+
ok sv_numne_flags($1, 11, 0), 'sv_numne_flags with no flags does not GETMAGIC';
17+
ok !sv_numne_flags($1, 11, SV_GMAGIC), 'sv_numne_flags with SV_GMAGIC does';
18+
19+
{
20+
package AlwaysTwelve {
21+
use overload
22+
'!=' => sub { return $_[1] != 12 },
23+
'0+' => sub { 11 };
24+
}
25+
my $obj = bless([], "AlwaysTwelve");
26+
27+
ok !sv_numne($obj, 12), 'AlwaysTwelve is 12';
28+
ok sv_numne($obj, 11), 'AlwaysTwelve is not 11';
29+
ok !sv_numne(12, $obj), 'AlwaysTwelve is 12 on right';
30+
ok sv_numne(11, $obj), 'AlwayeTwelve is not 11 on the right';
31+
32+
ok !sv_numne_flags($obj, 11, SV_SKIP_OVERLOAD), 'AlwaysTwelve is 12 with SV_SKIP_OVERLOAD'
33+
}
34+
35+
done_testing();

‎proto.h‎

Lines changed: 7 additions & 0 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎sv.c‎

Lines changed: 54 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -8759,6 +8759,60 @@ Perl_sv_numeq_flags(pTHX_ SV *sv1, SV *sv2, const U32 flags)
87598759
return do_ncmp(sv1, sv2) == 0;
87608760
}
87618761

8762+
/*
8763+
8764+
=for apidoc sv_numne
8765+
=for apidoc_item sv_numne_flags
8766+
8767+
These each return a boolean indicating if the numbers in the two SV arguments
8768+
are different, coercing them to numbers if necessary, basically behaving like
8769+
the Perl code S<C<$sv1 != $sv2>>.
8770+
8771+
A NULL SV is treated as C<undef>.
8772+
8773+
C<sv_numne> always performs 'get' magic. C<sv_numne_flags> performs 'get'
8774+
magic only if C<flags> has the C<SV_GMAGIC> bit set.
8775+
8776+
C<sv_numne> always checks for, and if present, handles C<!=> overloading. If
8777+
not present, regular numerical comparison will be used instead.
8778+
C<sv_numne_flags> normally does the same, but setting the C<SV_SKIP_OVERLOAD>
8779+
bit set in C<flags> causes it to use regular numerical comparison.
8780+
8781+
Otherwise, the functions behave identically.
8782+
8783+
=for apidoc Amnh||SV_SKIP_OVERLOAD
8784+
8785+
=cut
8786+
*/
8787+
8788+
bool
8789+
Perl_sv_numne_flags(pTHX_ SV *sv1, SV *sv2, const U32 flags)
8790+
{
8791+
PERL_ARGS_ASSERT_SV_NUMNE_FLAGS;
8792+
8793+
if(flags & SV_GMAGIC) {
8794+
if(sv1)
8795+
SvGETMAGIC(sv1);
8796+
if(sv2)
8797+
SvGETMAGIC(sv2);
8798+
}
8799+
8800+
/* Treat NULL as undef */
8801+
if(!sv1)
8802+
sv1 = &PL_sv_undef;
8803+
if(!sv2)
8804+
sv2 = &PL_sv_undef;
8805+
8806+
if(!(flags & SV_SKIP_OVERLOAD) &&
8807+
(SvAMAGIC(sv1) || SvAMAGIC(sv2))) {
8808+
SV *ret = amagic_call(sv1, sv2, ne_amg, 0);
8809+
if(ret)
8810+
return SvTRUE(ret);
8811+
}
8812+
8813+
return do_ncmp(sv1, sv2) != 0;
8814+
}
8815+
87628816
/*
87638817
=for apidoc sv_cmp
87648818
=for apidoc_item sv_cmp_flags

‎sv.h‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2322,6 +2322,7 @@ Usually accessed via the C<SvPVutf8_nolen> macro.
23222322
#define sv_cmp(sv1, sv2) sv_cmp_flags(sv1, sv2, SV_GMAGIC)
23232323
#define sv_cmp_locale(sv1, sv2) sv_cmp_locale_flags(sv1, sv2, SV_GMAGIC)
23242324
#define sv_numeq(sv1, sv2) sv_numeq_flags(sv1, sv2, SV_GMAGIC)
2325+
#define sv_numne(sv1, sv2) sv_numne_flags(sv1, sv2, SV_GMAGIC)
23252326
#define sv_streq(sv1, sv2) sv_streq_flags(sv1, sv2, SV_GMAGIC)
23262327
#define sv_collxfrm(sv, nxp) sv_collxfrm_flags(sv, nxp, SV_GMAGIC)
23272328
#define sv_2bool(sv) sv_2bool_flags(sv, SV_GMAGIC)

0 commit comments

Comments
 (0)