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

add SV_FORCE_OVERLOAD to the sv_numcmp() APIs

Browse Source 
and add AMGf_force_overload to amagic_call() which does the actual work.
This commit is contained in:
Tony Cook 2025-12-11 14:05:25 +11:00
parent e11f0edb1a
commit 1840104512
6 changed files with 112 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
ext/XS-APItest/Makefile.PL
View File

@ -25,7 +25,7 @@ my @names = (qw(HV_DELETE HV_DISABLE_UVAR_XKEY HV_FETCH_ISSTORE
G_SCALAR G_LIST G_VOID G_DISCARD G_EVAL G_NOARGS
G_KEEPERR G_NODEBUG G_METHOD G_FAKINGEVAL G_RETHROW
GV_NOADD_NOINIT G_USEHINTS
SV_GMAGIC SV_SKIP_OVERLOAD SV_POSBYTES
SV_GMAGIC SV_SKIP_OVERLOAD SV_FORCE_OVERLOAD SV_POSBYTES
IS_NUMBER_IN_UV IS_NUMBER_GREATER_THAN_UV_MAX
IS_NUMBER_NOT_INT IS_NUMBER_NEG IS_NUMBER_INFINITY
IS_NUMBER_NAN IS_NUMBER_TRAILING PERL_SCAN_TRAILING

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

@ -1,6 +1,6 @@
#!perl
use Test::More tests => 24;
use Test::More tests => 34;
use XS::APItest;
use Config;
@ -44,13 +44,30 @@ ok !sv_numne_flags($1, 11, SV_GMAGIC), 'sv_numne_flags with SV_GMAGIC does';
ok !sv_numne(12, $obj), 'AlwaysTwelve is 12 on right';
ok sv_numne(11, $obj), 'AlwayeTwelve is not 11 on the right';
ok !sv_numne_flags($obj, 11, SV_SKIP_OVERLOAD), 'AlwaysTwelve is 12 with SV_SKIP_OVERLOAD';
# neither '!=' nor '0+' overloading applies
ok sv_numne_flags($obj, 11, SV_SKIP_OVERLOAD), 'AlwaysTwelve is not 11 with SV_SKIP_OVERLOAD';
ok sv_numne_flags($obj, 12, SV_SKIP_OVERLOAD), 'AlwaysTwelve is not 12 with SV_SKIP_OVERLOAD';
my $result;
void_sv_numne($obj, 11, $result);
ok($result, "overloaded sv_numne() (ne) in void context");
void_sv_numne($obj, 12, $result);
ok(!$result, "overloaded sv_numne() (eq) in void context");
no overloading;
ok sv_numne($obj, 11), 'AlwaysTwelve is not 11 with no overloading (api)';
ok $obj != 11, 'AlwaysTwelve is not 11 with no overloading (op)';
ok sv_numne($obj, 12), 'AlwaysTwelve is not 12 with no overloading (api)';
ok $obj != 12, 'AlwaysTwelve is not 12 with no overloading (op)';
ok !sv_numne_flags($obj, 12, SV_FORCE_OVERLOAD), 'AlwaysTwelve is 12 with no overloading and SV_FORCE_OVERLOAD';
use overloading;
no overloading '!=';
ok !sv_numne($obj, 11), 'AlwaysTwelve is 11 with no overloading "!=" (api)';
ok !($obj != 11), 'AlwaysTwelve is 11 with no overloading "!=" (op)';
ok sv_numne($obj, 12), 'AlwaysTwelve is not 12 with no overloading "!=" (api)';
ok $obj != 12, 'AlwaysTwelve is not 12 with no overloading "!=" (op)';
}
# +0 overloading with large numbers and using fallback

8
gv.c
View File

@ -3754,6 +3754,10 @@ In many cases amagic_call() uses the L</GIMME_V> context of the
current OP when calling the sub handling the overload. This flag
forces amagic_call() to use scalar context.
=item C<AMGf_force_overload>
Perform overloading even in the context of C<no overloading;>.
=back
=for apidoc Amnh||AMGf_noleft
@ -3761,6 +3765,7 @@ forces amagic_call() to use scalar context.
=for apidoc Amnh||AMGf_unary
=for apidoc Amnh||AMGf_assign
=for apidoc Amnh||AMGf_force_scalar
=for apidoc Amnh||AMGf_force_overload
=cut
*/
@ -3785,7 +3790,8 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
PERL_ARGS_ASSERT_AMAGIC_CALL;
if ( PL_curcop->cop_hints & HINT_NO_AMAGIC ) {
if ( (PL_curcop->cop_hints & HINT_NO_AMAGIC)
&& !(flags & AMGf_force_overload)) {
if (!amagic_is_enabled(method)) return NULL;
}

15
pp.h
View File

@ -662,6 +662,7 @@ Does not use C<TARG>. See also C<L</XPUSHu>>, C<L</mPUSHu>> and C<L</PUSHu>>.
#define AMGf_want_list 0x0040
#define AMGf_numarg 0x0080
#define AMGf_force_scalar 0x0100
#define AMGf_force_overload SV_FORCE_OVERLOAD /* ignore HINTS_NO_AMAGIC */
/* do SvGETMAGIC on the stack args before checking for overload */
@ -677,9 +678,23 @@ Does not use C<TARG>. See also C<L</XPUSHu>>, C<L</mPUSHu>> and C<L</PUSHu>>.
return NORMAL; \
} STMT_END
/*
=for apidoc Am|SV *|AMG_CALLunary|SV *sv|int meth
=for apidoc_item |SV *|AMG_CALLunary_flags|SV *sv|int meth|int flags
Macro wrappers around L</amagic_call> to call any unary magic.
Sets the C<AMGf_noright> and C<AMGf_unary> flags.
=cut
*/
#define AMG_CALLunary(sv,meth) \
amagic_call(sv,&PL_sv_undef, meth, AMGf_noright | AMGf_unary)
#define AMG_CALLunary_flags(sv,meth, flags) \
amagic_call(sv,&PL_sv_undef, meth, AMGf_noright | AMGf_unary | (flags))
/* No longer used in core. Use AMG_CALLunary instead */
#define AMG_CALLun(sv,meth) AMG_CALLunary(sv, CAT2(meth,_amg))

87
sv.c
View File

@ -2765,14 +2765,25 @@ Perl_sv_2nv_flags(pTHX_ SV *const sv, const I32 flags)
/*
=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.
For sv_2num_flags() you can set the following flags:
=over
=item *
C<SV_SKIP_OVERLOAD> - avoid any numeric context overloading.
=item *
C<SV_FORCE_OVERLOAD> - use numeric context overloading even if
disabled in hints by C<no overloading;>.
=back
=cut
*/
@ -2782,15 +2793,18 @@ Perl_sv_2num_flags(pTHX_ SV *const sv, int flags)
{
PERL_ARGS_ASSERT_SV_2NUM_FLAGS;
assert((flags & ~SV_SKIP_OVERLOAD) == 0);
assert((flags & ~(SV_SKIP_OVERLOAD|SV_FORCE_OVERLOAD)) == 0);
if (!SvROK(sv))
return sv;
if (SvAMAGIC(sv) && !(flags & SV_SKIP_OVERLOAD)) {
SV * const tmpsv = AMG_CALLunary(sv, numer_amg);
STATIC_ASSERT_STMT(AMGf_force_overload == SV_FORCE_OVERLOAD);
SV * const tmpsv =
AMG_CALLunary_flags(sv, numer_amg,
(flags & SV_FORCE_OVERLOAD));
TAINT_IF(tmpsv && SvTAINTED(tmpsv));
if (tmpsv && (!SvROK(tmpsv) || (SvRV(tmpsv) != SvRV(sv))))
return sv_2num(tmpsv);
return sv_2num_flags(tmpsv, flags);
}
return sv_2mortal(newSVuv(PTR2UV(SvRV(sv))));
}
@ -8723,8 +8737,12 @@ S_sv_numcmp_common(pTHX_ SV **sv1, SV **sv2, const U32 flags,
*sv2 = &PL_sv_undef;
if (SvAMAGIC(*sv1) || SvAMAGIC(*sv2)) {
if (!(flags & SV_SKIP_OVERLOAD)) {
if ((*result = amagic_call(*sv1, *sv2, method, AMGf_force_scalar)))
STATIC_ASSERT_STMT(AMGf_force_overload == SV_FORCE_OVERLOAD);
if (!(flags & SV_SKIP_OVERLOAD)
|| (flags & SV_FORCE_OVERLOAD)) {
int amg_flags = AMGf_force_scalar
| (flags & AMGf_force_overload);
if ((*result = amagic_call(*sv1, *sv2, method, amg_flags)))
return true;
}
@ -8805,7 +8823,8 @@ different to C< !sv_numne(sv1, sv2) >.
The non-C<_flags> suffix versions of these functions always perform
get magic and handle the appropriate type of overloading. See
L<overload> for details.
L<overload> for details. Be aware that like the builtin operators,
C<no overloading;> will disable overloading.
These each return a boolean indicating if the numbers in the two SV
arguments satisfy the given relationship, coercing them to numbers if
@ -8824,11 +8843,22 @@ otherwise 'get' magic is ignored.
=item C<SV_SKIP_OVERLOAD>
Skip any operator overloading implemented for this type and operator.
Skip any operator or numeric overloading implemented for this type and
operator. Be aware that for overloaded values this will compare the
addresses of the references, as for the usual numeric comparison of
non-overloaded references.
=item C<SV_FORCE_OVERLOAD>
Force overloading on even in the context of C<no overloading;>.
=back
If neither overload flag is set overloading is honored unless C<no
overloading;> has disabled it.
=for apidoc Amnh||SV_SKIP_OVERLOAD
=for apidoc Amnh||SV_FORCE_OVERLOAD
=cut
*/
@ -8942,15 +8972,36 @@ because one of them is C<NaN>, though overloads can extend that.
=back
C<sv_numcmp> always performs 'get' magic. C<sv_numcmp_flags> performs
'get' magic on if C<flags> has the C<SV_GMAGIC> bit set.
C<sv_numcmp> always performs 'get' magic.
C<sv_numcmp> always checks for, and if present, handles C<< <=> >>
overloading. If not present, regular numerical comparison will be
used instead.
C<sv_numcmp_flags> normally does the same, but if the
C<SV_SKIP_OVERLOAD> bit is set in C<flags> any C<< <=> >> overloading
is ignored and a regular numerical comparison is done instead.
<sv_numcmp_flags> accepts these flags:
=over
=item *
C<SV_GMAGIC> - Perform 'get' magic on both C<sv1> amd C<sv2> if this
flag is set, otherwise 'get' magic is ignored.
=item *
C<SV_SKIP_OVERLOAD> - If this is set any C<< <=> >> or numeric
overloading implemented for this type is ignored. Be aware that for
overloaded values this will compare the addresses of the references,
as for the usual numeric comparison of non-overloaded references.
=item *
C<SV_FORCE_OVERLOAD> - Force overloading on even in the context of
C<no overloading;>.
=back
If neither overload flag is set overloading is honored unless C<no
overloading;> has disabled it.
=for apidoc Amnh||SV_SKIP_OVERLOAD
=for apidoc Amnh||SV_FORCE_OVERLOAD
=cut
*/

1
sv.h
View File

@ -2147,6 +2147,7 @@ Returns the hash for C<sv> created by C<L</newSVpvn_share>>.
#define SV_SKIP_OVERLOAD (1 << 13) /* 0x2000 - 8192 */
#define SV_CATBYTES (1 << 14) /* 0x4000 - 16384 */
#define SV_CATUTF8 (1 << 15) /* 0x8000 - 32768 */
#define SV_FORCE_OVERLOAD (1 << 16) /* 0x10000 - 65536 */
/* sv_regex_global_pos_*() should count in bytes, not chars */
#define SV_POSBYTES SV_CATBYTES