sv_numeq etc: don't do numify overloading with SV_SKIP_OVERLOAD

Author: tonycoz

embed.fnc

@@ -3410,7 +3410,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 			\
@@ -3421,6 +3421,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 			\

embed.h

@@ -281,6 +281,7 @@
 #   undef case_98_SBOX32
 #   undef case_99_SBOX32
 #   undef case_9_SBOX32
+#   undef sv_2num
 #   if !defined(PERL_EXT)
 #     undef invlist_intersection_
 #     undef invlist_subtract_
@@ -1383,7 +1384,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)
@@ -2047,6 +2048,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

ext/XS-APItest/t/sv_numeq.t

@@ -1,6 +1,6 @@
 #!perl
 
-use Test::More tests => 22;
+use Test::More tests => 23;
 use XS::APItest;
 use Config;
 
@@ -44,7 +44,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

proto.h

@@ -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))))
@@ -8727,16 +8734,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;
@@ -8826,7 +8837,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
 

sv.c

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