From 18401045121f0cc15b563b9184e736e1d74acc9f Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Thu, 11 Dec 2025 14:05:25 +1100 Subject: [PATCH] add SV_FORCE_OVERLOAD to the sv_numcmp() APIs and add AMGf_force_overload to amagic_call() which does the actual work. --- ext/XS-APItest/Makefile.PL | 2 +- ext/XS-APItest/t/sv_numne.t | 21 ++++++++- gv.c | 8 +++- pp.h | 15 +++++++ sv.c | 87 +++++++++++++++++++++++++++++-------- sv.h | 1 + 6 files changed, 112 insertions(+), 22 deletions(-) diff --git a/ext/XS-APItest/Makefile.PL b/ext/XS-APItest/Makefile.PL index 479d5566d6..bf0e6a4144 100644 --- a/ext/XS-APItest/Makefile.PL +++ b/ext/XS-APItest/Makefile.PL @@ -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 diff --git a/ext/XS-APItest/t/sv_numne.t b/ext/XS-APItest/t/sv_numne.t index 938b52de74..05b07ebee7 100644 --- a/ext/XS-APItest/t/sv_numne.t +++ b/ext/XS-APItest/t/sv_numne.t @@ -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 diff --git a/gv.c b/gv.c index 9ad566c01b..132abe6eee 100644 --- a/gv.c +++ b/gv.c @@ -3754,6 +3754,10 @@ In many cases amagic_call() uses the L context of the current OP when calling the sub handling the overload. This flag forces amagic_call() to use scalar context. +=item C + +Perform overloading even in the context of C. + =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; } diff --git a/pp.h b/pp.h index c1ae8c3ad5..0eb254b1c2 100644 --- a/pp.h +++ b/pp.h @@ -662,6 +662,7 @@ Does not use C. See also C>, C> and C>. #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. See also C>, C> and C>. 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 to call any unary magic. + +Sets the C and C 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)) diff --git a/sv.c b/sv.c index a3ed825ebc..060f88f368 100644 --- a/sv.c +++ b/sv.c @@ -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 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 in flags to avoid -any numeric context overloading. +For sv_2num_flags() you can set the following flags: + +=over + +=item * + +C - avoid any numeric context overloading. + +=item * + +C - use numeric context overloading even if +disabled in hints by C. + +=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 for details. +L for details. Be aware that like the builtin operators, +C 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 -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 + +Force overloading on even in the context of C. =back +If neither overload flag is set overloading is honored unless C 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, though overloads can extend that. =back -C always performs 'get' magic. C performs -'get' magic on if C has the C bit set. +C always performs 'get' magic. -C always checks for, and if present, handles C<< <=> >> -overloading. If not present, regular numerical comparison will be -used instead. -C normally does the same, but if the -C bit is set in C any C<< <=> >> overloading -is ignored and a regular numerical comparison is done instead. + accepts these flags: + +=over + +=item * + +C - Perform 'get' magic on both C amd C if this +flag is set, otherwise 'get' magic is ignored. + +=item * + +C - 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 - Force overloading on even in the context of +C. + +=back + +If neither overload flag is set overloading is honored unless C has disabled it. + +=for apidoc Amnh||SV_SKIP_OVERLOAD +=for apidoc Amnh||SV_FORCE_OVERLOAD =cut */ diff --git a/sv.h b/sv.h index 4c1102288c..4f90807dea 100644 --- a/sv.h +++ b/sv.h @@ -2147,6 +2147,7 @@ Returns the hash for C created by C>. #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