sv.c: extract the common parts of sv_numeq_flags and sv_numne_flags

Author: tonycoz

embed.fnc

@@ -6060,6 +6060,12 @@ S	|const char *|sv_display|NN SV * const sv			\
 				|NN char *tmpbuf			\
 				|STRLEN tmpbuf_size
 S	|bool	|sv_2iuv_common |NN SV * const sv
+S	|bool	|sv_numcmp_common					\
+				|NULLOK SV **sv1			\
+				|NULLOK SV **sv2			\
+				|const U32 flags			\
+				|int method				\
+				|NN bool *result
 S	|STRLEN |sv_pos_b2u_midway					\
 				|SPTR const U8 * const s		\
 				|MPTR const U8 * const target		\

embed.h

@@ -1686,6 +1686,7 @@
 #     define sv_2iuv_common(a)                  S_sv_2iuv_common(aTHX_ a)
 #     define sv_add_arena(a,b,c)                S_sv_add_arena(aTHX_ a,b,c)
 #     define sv_display(a,b,c)                  S_sv_display(aTHX_ a,b,c)
+#     define sv_numcmp_common(a,b,c,d,e)        S_sv_numcmp_common(aTHX_ a,b,c,d,e)
 #     define sv_pos_b2u_midway(a,b,c,d)         S_sv_pos_b2u_midway(aTHX_ a,b,c,d)
 #     define sv_pos_u2b_cached(a,b,c,d,e,f,g)   S_sv_pos_u2b_cached(aTHX_ a,b,c,d,e,f,g)
 #     define sv_pos_u2b_forwards                S_sv_pos_u2b_forwards

ext/XS-APItest/APItest.xs

@@ -1640,6 +1640,8 @@ signal_thread_start(void *arg) {
 #  define hwm_checks_enabled() false
 #endif
 
+typedef SV *nullable_SV;
+
 MODULE = XS::APItest            PACKAGE = XS::APItest
 
 INCLUDE: const-xs.inc
@@ -5005,26 +5007,36 @@ test_HvNAMEf_QUOTEDPREFIX(sv)
     OUTPUT:
         RETVAL
 
+TYPEMAP: <<HERE
+
+nullable_SV	T_NULLABLE_SV
+
+INPUT
+
+T_NULLABLE_SV
+    $var = $arg == &PL_sv_undef ? NULL : $arg;
+
+HERE
 
 bool
-sv_numeq(SV *sv1, SV *sv2)
+sv_numeq(nullable_SV sv1, nullable_SV sv2)
     CODE:
         RETVAL = sv_numeq(sv1, sv2);
     OUTPUT:
         RETVAL
 
 bool
-sv_numeq_flags(SV *sv1, SV *sv2, U32 flags)
+sv_numeq_flags(nullable_SV sv1, nullable_SV sv2, U32 flags)
     CODE:
         RETVAL = sv_numeq_flags(sv1, sv2, flags);
     OUTPUT:
         RETVAL
 
 bool
-sv_numne(SV *sv1, SV *sv2)
+sv_numne(nullable_SV sv1, nullable_SV sv2)
 
 bool
-sv_numne_flags(SV *sv1, SV *sv2, U32 flags)
+sv_numne_flags(nullable_SV sv1, nullable_SV sv2, U32 flags)
 
 bool
 sv_streq(SV *sv1, SV *sv2)

ext/XS-APItest/t/sv_numeq.t

@@ -1,6 +1,6 @@
 #!perl
 
-use Test::More tests => 11;
+use Test::More tests => 13;
 use XS::APItest;
 
 my $four = 4;
@@ -11,6 +11,10 @@ my $six_point_five = 6.5; # an exact float, so == is fine
 ok  sv_numeq($six_point_five, 6.5), '$six_point_five == 6.5';
 ok !sv_numeq($six_point_five, 6.6), '$six_point_five != 6.6';
 
+# NULLs
+ok sv_numeq(undef, 0), "NULL sv1";
+ok sv_numeq(0, undef), "NULL sv2";
+
 # GMAGIC
 "10" =~ m/(\d+)/;
 ok !sv_numeq_flags($1, 10, 0), 'sv_numeq_flags with no flags does not GETMAGIC';

ext/XS-APItest/t/sv_numne.t

@@ -1,6 +1,6 @@
 #!perl
 
-use Test::More tests => 11;
+use Test::More tests => 13;
 use XS::APItest;
 
 my $four = 4;
@@ -11,6 +11,10 @@ my $six_point_five = 6.5; # an exact float, so == is fine
 ok !sv_numne($six_point_five, 6.5), '$six_point_five == 6.5';
 ok  sv_numne($six_point_five, 6.6), '$six_point_five != 6.6';
 
+# NULLs
+ok sv_numne(undef, 1), "NULL sv1";
+ok sv_numne(1, undef), "NULL sv2";
+
 # GMAGIC
 "11" =~ m/(\d+)/;
 ok  sv_numne_flags($1, 11, 0), 'sv_numne_flags with no flags does not GETMAGIC';

proto.h

@@ -8705,6 +8705,33 @@ Perl_sv_streq_flags(pTHX_ SV *sv1, SV *sv2, const U32 flags)
     return sv_eq_flags(sv1, sv2, 0);
 }
 
+PERL_STATIC_INLINE bool
+S_sv_numcmp_common(pTHX_ SV **sv1, SV **sv2, const U32 flags,
+                   int method, bool *result) {
+    if(flags & SV_GMAGIC) {
+        if(*sv1)
+            SvGETMAGIC(*sv1);
+        if(*sv2)
+            SvGETMAGIC(*sv2);
+    }
+
+    /* Treat NULL as undef */
+    if(!*sv1)
+        *sv1 = &PL_sv_undef;
+    if(!*sv2)
+        *sv2 = &PL_sv_undef;
+
+    SV *sv_result;
+    if(!(flags & SV_SKIP_OVERLOAD) &&
+       (SvAMAGIC(*sv1) || SvAMAGIC(*sv2)) &&
+       (sv_result = amagic_call(*sv1, *sv2, method, 0))) {
+        *result = SvTRUE(sv_result);
+        return true;
+    }
+
+    return false;
+}
+
 /*
 
 =for apidoc      sv_numeq
@@ -8736,25 +8763,9 @@ Perl_sv_numeq_flags(pTHX_ SV *sv1, SV *sv2, const U32 flags)
 {
     PERL_ARGS_ASSERT_SV_NUMEQ_FLAGS;
 
-    if(flags & SV_GMAGIC) {
-        if(sv1)
-            SvGETMAGIC(sv1);
-        if(sv2)
-            SvGETMAGIC(sv2);
-    }
-
-    /* Treat NULL as undef */
-    if(!sv1)
-        sv1 = &PL_sv_undef;
-    if(!sv2)
-        sv2 = &PL_sv_undef;
-
-    if(!(flags & SV_SKIP_OVERLOAD) &&
-            (SvAMAGIC(sv1) || SvAMAGIC(sv2))) {
-        SV *ret = amagic_call(sv1, sv2, eq_amg, 0);
-        if(ret)
-            return SvTRUE(ret);
-    }
+    bool result;
+    if (UNLIKELY(sv_numcmp_common(&sv1, &sv2, flags, eq_amg, &result)))
+        return result;
 
     return do_ncmp(sv1, sv2) == 0;
 }
@@ -8790,25 +8801,10 @@ Perl_sv_numne_flags(pTHX_ SV *sv1, SV *sv2, const U32 flags)
 {
     PERL_ARGS_ASSERT_SV_NUMNE_FLAGS;
 
-    if(flags & SV_GMAGIC) {
-        if(sv1)
-            SvGETMAGIC(sv1);
-        if(sv2)
-            SvGETMAGIC(sv2);
-    }
-
-    /* Treat NULL as undef */
-    if(!sv1)
-        sv1 = &PL_sv_undef;
-    if(!sv2)
-        sv2 = &PL_sv_undef;
 
-    if(!(flags & SV_SKIP_OVERLOAD) &&
-            (SvAMAGIC(sv1) || SvAMAGIC(sv2))) {
-        SV *ret = amagic_call(sv1, sv2, ne_amg, 0);
-        if(ret)
-            return SvTRUE(ret);
-    }
+    bool result;
+    if (UNLIKELY(sv_numcmp_common(&sv1, &sv2, flags, ne_amg, &result)))
+        return result;
 
     return do_ncmp(sv1, sv2) != 0;
 }