add sv_numle(), sv_numlt(), sv_numge(), sv_numgt() APIs

These are all needed because overloading may make them inconsistent
with <=> overloading.

Author: tonycoz

MANIFEST

@@ -5193,6 +5193,7 @@ ext/XS-APItest/t/subcall.t			Test XSUB calls
 ext/XS-APItest/t/subsignature.t			Test parse_subsignature()
 ext/XS-APItest/t/sv_numcmp.t			Test sv_numcmp
 ext/XS-APItest/t/sv_numeq.t			Test sv_numeq
+ext/XS-APItest/t/sv_numlget.t			Test sv_num[lg][et]
 ext/XS-APItest/t/sv_numne.t			Test sv_numne
 ext/XS-APItest/t/sv_streq.t			Test sv_streq
 ext/XS-APItest/t/svcat.t			Test sv_catpvn

embed.fnc

@@ -3424,6 +3424,26 @@ Admp	|bool	|sv_numeq	|NULLOK SV *sv1 			\
 Adp	|bool	|sv_numeq_flags |NULLOK SV *sv1 			\
 				|NULLOK SV *sv2 			\
 				|const U32 flags
+Admp	|bool	|sv_numge	|NULLOK SV *sv1 			\
+				|NULLOK SV *sv2
+Adp	|bool	|sv_numge_flags |NULLOK SV *sv1 			\
+				|NULLOK SV *sv2 			\
+				|const U32 flags
+Admp	|bool	|sv_numgt	|NULLOK SV *sv1 			\
+				|NULLOK SV *sv2
+Adp	|bool	|sv_numgt_flags |NULLOK SV *sv1 			\
+				|NULLOK SV *sv2 			\
+				|const U32 flags
+Admp	|bool	|sv_numle	|NULLOK SV *sv1 			\
+				|NULLOK SV *sv2
+Adp	|bool	|sv_numle_flags |NULLOK SV *sv1 			\
+				|NULLOK SV *sv2 			\
+				|const U32 flags
+Admp	|bool	|sv_numlt	|NULLOK SV *sv1 			\
+				|NULLOK SV *sv2
+Adp	|bool	|sv_numlt_flags |NULLOK SV *sv1 			\
+				|NULLOK SV *sv2 			\
+				|const U32 flags
 Admp	|bool	|sv_numne	|NULLOK SV *sv1 			\
 				|NULLOK SV *sv2
 Adp	|bool	|sv_numne_flags |NULLOK SV *sv1 			\

embed.h

@@ -728,6 +728,10 @@
 # define sv_nosharing(a)                        Perl_sv_nosharing(aTHX_ a)
 # define sv_numcmp_flags(a,b,c)                 Perl_sv_numcmp_flags(aTHX_ a,b,c)
 # define sv_numeq_flags(a,b,c)                  Perl_sv_numeq_flags(aTHX_ a,b,c)
+# define sv_numge_flags(a,b,c)                  Perl_sv_numge_flags(aTHX_ a,b,c)
+# define sv_numgt_flags(a,b,c)                  Perl_sv_numgt_flags(aTHX_ a,b,c)
+# define sv_numle_flags(a,b,c)                  Perl_sv_numle_flags(aTHX_ a,b,c)
+# define sv_numlt_flags(a,b,c)                  Perl_sv_numlt_flags(aTHX_ a,b,c)
 # define sv_numne_flags(a,b,c)                  Perl_sv_numne_flags(aTHX_ a,b,c)
 # define sv_peek(a)                             Perl_sv_peek(aTHX_ a)
 # define sv_pos_b2u(a,b)                        Perl_sv_pos_b2u(aTHX_ a,b)
@@ -2349,6 +2353,10 @@
 #   define Perl_sv_mortalcopy(mTHX,a)           sv_mortalcopy(a)
 #   define Perl_sv_numcmp(mTHX,a,b)             sv_numcmp(a,b)
 #   define Perl_sv_numeq(mTHX,a,b)              sv_numeq(a,b)
+#   define Perl_sv_numge(mTHX,a,b)              sv_numge(a,b)
+#   define Perl_sv_numgt(mTHX,a,b)              sv_numgt(a,b)
+#   define Perl_sv_numle(mTHX,a,b)              sv_numle(a,b)
+#   define Perl_sv_numlt(mTHX,a,b)              sv_numlt(a,b)
 #   define Perl_sv_numne(mTHX,a,b)              sv_numne(a,b)
 #   define Perl_sv_pv(mTHX,a)                   sv_pv(a)
 #   define Perl_sv_pvbyte(mTHX,a)               sv_pvbyte(a)
@@ -2452,6 +2460,10 @@
 #   define Perl_sv_mortalcopy                   sv_mortalcopy
 #   define Perl_sv_numcmp                       sv_numcmp
 #   define Perl_sv_numeq                        sv_numeq
+#   define Perl_sv_numge                        sv_numge
+#   define Perl_sv_numgt                        sv_numgt
+#   define Perl_sv_numle                        sv_numle
+#   define Perl_sv_numlt                        sv_numlt
 #   define Perl_sv_numne                        sv_numne
 #   define Perl_sv_pv                           sv_pv
 #   define Perl_sv_pvbyte                       sv_pvbyte

ext/XS-APItest/APItest.xs

@@ -5044,6 +5044,30 @@ sv_numcmp(nullable_SV sv1, nullable_SV sv2)
 I32
 sv_numcmp_flags(nullable_SV sv1, nullable_SV sv2, U32 flags)
 
+bool
+sv_numle(nullable_SV sv1, nullable_SV sv2)
+
+bool
+sv_numle_flags(nullable_SV sv1, nullable_SV sv2, U32 flags)
+
+bool
+sv_numlt(nullable_SV sv1, nullable_SV sv2)
+
+bool
+sv_numlt_flags(nullable_SV sv1, nullable_SV sv2, U32 flags)
+
+bool
+sv_numge(nullable_SV sv1, nullable_SV sv2)
+
+bool
+sv_numge_flags(nullable_SV sv1, nullable_SV sv2, U32 flags)
+
+bool
+sv_numgt(nullable_SV sv1, nullable_SV sv2)
+
+bool
+sv_numgt_flags(nullable_SV sv1, nullable_SV sv2, U32 flags)
+
 bool
 sv_streq(SV *sv1, SV *sv2)
     CODE:

ext/XS-APItest/t/sv_numlget.t

@@ -0,0 +1,53 @@
+#!perl
+# tests the numeric sv_num[lg][te]() APIs
+
+use Test::More;
+use XS::APItest;
+use strict;
+
+# overloading
+package AlwaysTen {
+    use overload
+      '<=>' => sub {
+          return $_[2] ? $_[1] <=> 10  : 10 <=> $_[1]
+      },
+      '0+' => sub { 123456 };
+}
+
+# +0 overloading with large numbers and using fallback
+package MyBigNum {
+    use overload
+      "0+" => sub { $_[0][0] },
+      fallback => 1;
+}           
+
+my @values =
+    (
+    [ ~0 ],
+    [ ~0-1 ],
+    [ -int(~0/2) ],
+    [ 1.001 ],
+    [ 1.002 ],
+    [ bless([ ~0 ], "MyBigNum"), "bignum ~0" ],
+    [ bless([ ~0 ], "MyBigNum"), "bignum ~0 #2" ],
+    [ bless([ ~0-1 ], "MyBigNum"), "bignum ~0-1" ],
+    [ undef(), "undef" ],
+    [ 0+"NaN", "NaN" ],
+   );
+
+for my $x (@values) {
+    for my $y (@values) {
+        for my $func ( [ "le", sub { $_[0] <= $_[1] }, \&sv_numle ],
+                       [ "lt", sub { $_[0] <  $_[1] }, \&sv_numlt ],
+                       [ "ge", sub { $_[0] >= $_[1] }, \&sv_numge ],
+                       [ "gt", sub { $_[0] >  $_[1] }, \&sv_numgt ]) {
+            my ($op, $native, $api) = @$func;
+            my $lname = $x->[1] // $x->[0];
+            my $rname = $y->[1] // $y->[0];
+            is($api->($x->[0], $x->[1]), $native->($x->[0], $x->[1]),
+               "$lname $op $rname");
+        }
+    }
+}
+
+done_testing;

proto.h

@@ -8748,6 +8748,14 @@ S_sv_numcmp_common(pTHX_ SV **sv1, SV **sv2, const U32 flags,
 =for apidoc_item sv_numeq_flags
 =for apidoc_item sv_numne
 =for apidoc_item sv_numne_flags
+=for apidoc_item sv_numge
+=for apidoc_item sv_numge_flags
+=for apidoc_item sv_numgt
+=for apidoc_item sv_numgt_flags
+=for apidoc_item sv_numle
+=for apidoc_item sv_numle_flags
+=for apidoc_item sv_numlt
+=for apidoc_item sv_numlt_flags
 
 These return a boolean that is the result of the corresponding numeric
 comparison:
@@ -8766,17 +8774,42 @@ Numeric equality, the same as S<C<$sv1 == $sv2>>.
 
 Numeric inequality, the same as S<C<$sv1 != $sv2>>.
 
+=item C<sv_numle>
+
+=item C<sv_numle_flags>
+
+Numeric less than or equal, the same as S<C<$sv1 E<lt>= $sv2>>.
+
+=item C<sv_numlt>
+
+=item C<sv_numlt_flags>
+
+Numeric less than, the same as S<C<$sv1 E<lt> $sv2>>.
+
+=item C<sv_numge>
+
+=item C<sv_numge_flags>
+
+Numeric greater than or equal, the same as S<C<$sv1 E<gt>= $sv2>>.
+
+=item C<sv_numgt>
+
+=item C<sv_numgt_flags>
+
+Numeric greater than, the same as S<C<$sv1 E<gt> $sv2>>.
+
 =back
 
-Beware that in the presence of overloading C<==> may not be a strict
-inverse of C<!=>.
+Beware that in the presence of overloading the comparisons might not
+have their normal properties, eg. C< sv_numeq(sv1, sv2) > might be
+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.
 
 These each return a boolean indicating if the numbers in the two SV
-arguments are equal or not equal, coercing them to numbers if
+arguments satisfy the given relationship, coercing them to numbers if
 necessary, basically behaving like the Perl code.
 
 A NULL SV is treated as C<undef>.
@@ -8819,14 +8852,65 @@ Perl_sv_numne_flags(pTHX_ SV *sv1, SV *sv2, const U32 flags)
 {
     PERL_ARGS_ASSERT_SV_NUMNE_FLAGS;
 
-
     SV *result;
     if (UNLIKELY(sv_numcmp_common(&sv1, &sv2, flags, ne_amg, &result)))
         return SvTRUE(result);
 
     return do_ncmp(sv1, sv2) != 0;
 }
 
+bool
+Perl_sv_numle_flags(pTHX_ SV *sv1, SV *sv2, const U32 flags)
+{
+    PERL_ARGS_ASSERT_SV_NUMLE_FLAGS;
+
+    SV *result;
+    if (UNLIKELY(sv_numcmp_common(&sv1, &sv2, flags, le_amg, &result)))
+        return SvTRUE(result);
+
+    return do_ncmp(sv1, sv2) <= 0;
+}
+
+bool
+Perl_sv_numlt_flags(pTHX_ SV *sv1, SV *sv2, const U32 flags)
+{
+    PERL_ARGS_ASSERT_SV_NUMLT_FLAGS;
+
+    SV *result;
+    if (UNLIKELY(sv_numcmp_common(&sv1, &sv2, flags, lt_amg, &result)))
+        return SvTRUE(result);
+
+    return do_ncmp(sv1, sv2) < 0;
+}
+
+bool
+Perl_sv_numge_flags(pTHX_ SV *sv1, SV *sv2, const U32 flags)
+{
+    PERL_ARGS_ASSERT_SV_NUMGE_FLAGS;
+
+    SV *result;
+    if (UNLIKELY(sv_numcmp_common(&sv1, &sv2, flags, ge_amg, &result)))
+        return SvTRUE(result);
+
+    I32 cmp = do_ncmp(sv1, sv2);
+
+    return cmp != 2 && cmp >= 0;
+}
+
+bool
+Perl_sv_numgt_flags(pTHX_ SV *sv1, SV *sv2, const U32 flags)
+{
+    PERL_ARGS_ASSERT_SV_NUMGT_FLAGS;
+
+    SV *result;
+    if (UNLIKELY(sv_numcmp_common(&sv1, &sv2, flags, gt_amg, &result)))
+        return SvTRUE(result);
+
+    I32 cmp = do_ncmp(sv1, sv2);
+
+    return cmp != 2 && cmp > 0;
+}
+
 /*
 =for apidoc      sv_numcmp
 =for apidoc_item sv_numcmp_flags

sv.c

@@ -2323,6 +2323,10 @@ Usually accessed via the C<SvPVutf8_nolen> macro.
 #define sv_cmp_locale(sv1, sv2) sv_cmp_locale_flags(sv1, sv2, SV_GMAGIC)
 #define sv_numeq(sv1, sv2) sv_numeq_flags(sv1, sv2, SV_GMAGIC)
 #define sv_numne(sv1, sv2) sv_numne_flags(sv1, sv2, SV_GMAGIC)
+#define sv_numle(sv1, sv2) sv_numle_flags(sv1, sv2, SV_GMAGIC)
+#define sv_numlt(sv1, sv2) sv_numlt_flags(sv1, sv2, SV_GMAGIC)
+#define sv_numge(sv1, sv2) sv_numge_flags(sv1, sv2, SV_GMAGIC)
+#define sv_numgt(sv1, sv2) sv_numgt_flags(sv1, sv2, SV_GMAGIC)
 #define sv_numcmp(sv1, sv2) sv_numcmp_flags(sv1, sv2, SV_GMAGIC)
 #define sv_streq(sv1, sv2) sv_streq_flags(sv1, sv2, SV_GMAGIC)
 #define sv_collxfrm(sv, nxp) sv_collxfrm_flags(sv, nxp, SV_GMAGIC)