Have sv_numeq() respect == overloading unless the SV_SKIP_OVERLOAD flag is passed

diff --git a/ext/XS-APItest/Makefile.PL b/ext/XS-APItest/Makefile.PL
index 16b024e..b666a3d 100644 (file)
--- 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
-               SV_GMAGIC
+               SV_GMAGIC SV_SKIP_OVERLOAD
                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_numeq.t b/ext/XS-APItest/t/sv_numeq.t
index d183e67..1949715 100644 (file)
--- a/ext/XS-APItest/t/sv_numeq.t
+++ b/ext/XS-APItest/t/sv_numeq.t
@@ -1,6 +1,6 @@
 #!perl
 
-use Test::More tests => 6;
+use Test::More tests => 9;
 use XS::APItest;
 
 my $four = 4;
@@ -15,3 +15,17 @@ ok !sv_numeq($six_point_five, 6.6), '$six_point_five == 6.6';
 "10" =~ m/(\d+)/;
 ok !sv_numeq_flags($1, 10, 0), 'sv_numeq_flags with no flags does not GETMAGIC';
 ok  sv_numeq_flags($1, 10, SV_GMAGIC), 'sv_numeq_flags with SV_GMAGIC does';
+
+# overloading
+{
+    package AlwaysTen {
+        use overload
+            '==' => sub { return $_[1] == 10 },
+            '0+' => sub { 123456 };
+    }
+
+    ok  sv_numeq(bless([], "AlwaysTen"), 10), 'AlwaysTen is 10';
+    ok !sv_numeq(bless([], "AlwaysTen"), 11), 'AlwaysTen is not 11';
+
+    ok !sv_numeq_flags(bless([], "AlwaysTen"), 10, SV_SKIP_OVERLOAD), 'AlwaysTen is not 10 with SV_SKIP_OVERLOAD'
+}

diff --git a/sv.c b/sv.c
index 6b6ade7..628c103 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -8187,6 +8187,10 @@ identical. If the flags has the C<SV_GMAGIC> bit set, it handles
 get-magic too. Will coerce its args to numbers if necessary. Treats
 C<NULL> as undef.
 
+If flags does not have the C<SV_SKIP_OVERLOAD> set, an attempt to use C<==>
+overloading will be made. If such overloading does not exist or the flag is
+set, then regular numerical comparison will be used instead.
+
 =for apidoc sv_numeq
 
 A convenient shortcut for calling C<sv_numeq_flags> with the C<SV_GMAGIC>
@@ -8213,6 +8217,13 @@ Perl_sv_numeq_flags(pTHX_ SV *sv1, SV *sv2, const U32 flags)
     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);
+    }
+
     return do_ncmp(sv1, sv2) == 0;
 }