add SV_FORCE_OVERLOAD to the sv_numcmp() APIs

and add AMGf_force_overload to amagic_call() which does the actual work.

Author: tonycoz

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

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;
 
@@ -43,13 +43,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

gv.c

@@ -3754,13 +3754,18 @@ 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
 =for apidoc Amnh||AMGf_noright
 =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;
   }
 

pp.h

@@ -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))
 

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<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))));
 }
@@ -8735,8 +8749,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;
         }
 
@@ -8817,7 +8835,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
@@ -8836,11 +8855,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
 */
@@ -8954,15 +8984,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.
+
+<sv_numcmp_flags> accepts these flags:
 
-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.
+=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
 */

sv.h

@@ -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