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_numeq etc: don't do numify overloading with SV_SKIP_OVERLOAD

Browse Source
This commit is contained in:
Tony Cook 2025-12-04 09:58:51 +11:00
parent c93bd38fcc
commit e11f0edb1a
6 changed files with 42 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
embed.fnc
View File

@ -3430,7 +3430,7 @@ ARdp |SV * |sv_newmortal
Cdp |SV * |sv_newref |NULLOK SV * const sv
Adp |void |sv_nosharing |NULLOK SV *sv
: Used in pp.c, pp_hot.c, sv.c
dpx |SV * |sv_2num |NN SV * const sv
dmp |SV * |sv_2num |NN SV * const sv
Admp |I32 |sv_numcmp |NULLOK SV *sv1 \
|NULLOK SV *sv2
Adp |I32 |sv_numcmp_flags|NULLOK SV *sv1 \
@ -3441,6 +3441,8 @@ Admp |bool |sv_numeq |NULLOK SV *sv1 \
Adp |bool |sv_numeq_flags |NULLOK SV *sv1 \
|NULLOK SV *sv2 \
|const U32 flags
dpx |SV * |sv_2num_flags |NN SV * const sv \
|int flags
Admp |bool |sv_numge |NULLOK SV *sv1 \
|NULLOK SV *sv2
Adp |bool |sv_numge_flags |NULLOK SV *sv1 \

8
embed.h
View File

@ -283,6 +283,7 @@
# undef case_9_SBOX32
# undef CC_UNDERSCORE_
# undef isFOO_or_UNDERSCORE_
# undef sv_2num
# undef USE_STDIO
# if !defined(PERL_EXT)
# undef invlist_intersection_
@ -1392,7 +1393,7 @@
# define subsignature_append_slurpy(a,b) Perl_subsignature_append_slurpy(aTHX_ a,b)
# define subsignature_finish() Perl_subsignature_finish(aTHX)
# define subsignature_start() Perl_subsignature_start(aTHX)
# define sv_2num(a) Perl_sv_2num(aTHX_ a)
# define sv_2num_flags(a,b) Perl_sv_2num_flags(aTHX_ a,b)
# define sv_clean_all() Perl_sv_clean_all(aTHX)
# define sv_clean_objs() Perl_sv_clean_objs(aTHX)
# define sv_del_backref(a,b) Perl_sv_del_backref(aTHX_ a,b)
@ -2056,6 +2057,11 @@
# define quadmath_format_needed Perl_quadmath_format_needed
# define quadmath_format_valid Perl_quadmath_format_valid
# endif
# if defined(USE_THREADS)
# define Perl_sv_2num(mTHX,a) sv_2num(a)
# else
# define Perl_sv_2num sv_2num
# endif
# if defined(WIN32)
# define get_win32_message_utf8ness(a) Perl_get_win32_message_utf8ness(aTHX_ a)
# else

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

@ -1,6 +1,6 @@
#!perl
use Test::More tests => 22;
use Test::More tests => 23;
use XS::APItest;
use Config;
@ -46,7 +46,8 @@ ok sv_numeq_flags($1, 10, SV_GMAGIC), 'sv_numeq_flags with SV_GMAGIC does';
ok sv_numeq(10, $obj), 'AlwaysTen is 10 on the right';
ok !sv_numeq(11, $obj), 'AlwaysTen is not 11 on the right';
ok !sv_numeq_flags($obj, 10, SV_SKIP_OVERLOAD), 'AlwaysTen is not 10 with SV_SKIP_OVERLOAD'
ok !sv_numeq_flags($obj, 10, SV_SKIP_OVERLOAD), 'AlwaysTen is not 10 with SV_SKIP_OVERLOAD';
ok !sv_numeq_flags($obj, 123456, SV_SKIP_OVERLOAD), 'AlwaysTen is not its overloaded numeric value with SV_SKIP_OVERLOAD';
}
# +0 overloading with large numbers and using fallback

4
proto.h generated
View File

@ -4406,9 +4406,9 @@ Perl_sv_2mortal(pTHX_ SV * const sv);
#define PERL_ARGS_ASSERT_SV_2MORTAL
PERL_CALLCONV SV *
Perl_sv_2num(pTHX_ SV * const sv)
Perl_sv_2num_flags(pTHX_ SV * const sv, int flags)
__attribute__visibility__("hidden");
#define PERL_ARGS_ASSERT_SV_2NUM \
#define PERL_ARGS_ASSERT_SV_2NUM_FLAGS \
assert(sv)
PERL_CALLCONV NV

34
sv.c
View File

@ -2763,23 +2763,30 @@ Perl_sv_2nv_flags(pTHX_ SV *const sv, const I32 flags)
}
/*
=for apidoc sv_2num
=for apidoc sv_2num_flags
=for apidoc_item sv_2num
X<SV_SKIP_OVERLOAD>
Return an SV with the numeric value of the source SV, doing any necessary
reference or overload conversion. The caller is expected to have handled
get-magic already.
For sv_2num_flags() you can set C<SV_SKIP_OVERLOAD> in flags to avoid
any numeric context overloading.
=cut
*/
SV *
Perl_sv_2num(pTHX_ SV *const sv)
Perl_sv_2num_flags(pTHX_ SV *const sv, int flags)
{
PERL_ARGS_ASSERT_SV_2NUM;
PERL_ARGS_ASSERT_SV_2NUM_FLAGS;
assert((flags & ~SV_SKIP_OVERLOAD) == 0);
if (!SvROK(sv))
return sv;
if (SvAMAGIC(sv)) {
if (SvAMAGIC(sv) && !(flags & SV_SKIP_OVERLOAD)) {
SV * const tmpsv = AMG_CALLunary(sv, numer_amg);
TAINT_IF(tmpsv && SvTAINTED(tmpsv));
if (tmpsv && (!SvROK(tmpsv) || (SvRV(tmpsv) != SvRV(sv))))
@ -8715,16 +8722,20 @@ S_sv_numcmp_common(pTHX_ SV **sv1, SV **sv2, const U32 flags,
if(!*sv2)
*sv2 = &PL_sv_undef;
if(!(flags & SV_SKIP_OVERLOAD) &&
(SvAMAGIC(*sv1) || SvAMAGIC(*sv2))) {
if ((*result = amagic_call(*sv1, *sv2, method, AMGf_force_scalar)))
return true;
if (SvAMAGIC(*sv1) || SvAMAGIC(*sv2)) {
if (!(flags & SV_SKIP_OVERLOAD)) {
if ((*result = amagic_call(*sv1, *sv2, method, AMGf_force_scalar)))
return true;
}
/* normally handled by try_amagic_bin */
/* Normally handled by try_amagic_bin
This will do the normal RV to UV conversion
with SV_SKIP_OVERLOAD.
*/
if (SvROK(*sv1))
*sv1 = sv_2num(*sv1);
*sv1 = sv_2num_flags(*sv1, flags & SV_SKIP_OVERLOAD);
if (SvROK(*sv2))
*sv2 = sv_2num(*sv2);
*sv2 = sv_2num_flags(*sv2, flags & SV_SKIP_OVERLOAD);
}
return false;
@ -8814,7 +8825,6 @@ otherwise 'get' magic is ignored.
=item C<SV_SKIP_OVERLOAD>
Skip any operator overloading implemented for this type and operator.
Be aware that numeric, C<+0>, overloading will still be applied, unless in the scope of C<no overloading;>.
=back

5
sv.h
View File

@ -2311,6 +2311,7 @@ Usually accessed via the C<SvPVutf8_nolen> macro.
=cut
*/
#define sv_2num(sv) sv_2num_flags(sv, 0)
#define sv_2pvutf8_nolen(sv) sv_2pvutf8(sv, 0)
#define sv_2pv_nomg(sv, lp) sv_2pv_flags(sv, lp, 0)
#define sv_pvn_force(sv, lp) sv_pvn_force_flags(sv, lp, SV_GMAGIC)
@ -2366,6 +2367,10 @@ Usually accessed via the C<SvPVutf8_nolen> macro.
#define sv_catpvn_nomg_maybeutf8(dsv, sstr, len, is_utf8) \
sv_catpvn_flags(dsv, sstr, len, (is_utf8)?SV_CATUTF8:SV_CATBYTES)
#if defined(PERL_CORE)
#define sv_2num(sv) sv_2num_flags(sv, 0)
#endif
#if defined(PERL_CORE) || defined(PERL_EXT)
# define sv_or_pv_len_utf8(sv, pv, bytelen) \
(SvGAMAGIC(sv) \