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

author Paul "LeoNerd" Evans <leonerd@leonerd.org.uk>

Tue, 14 Sep 2021 20:30:42 +0000 (21:30 +0100)

committer Paul Evans <leonerd@leonerd.org.uk>

Wed, 26 Jan 2022 21:02:05 +0000 (21:02 +0000)
author Paul "LeoNerd" Evans <leonerd@leonerd.org.uk>
Tue, 14 Sep 2021 20:30:42 +0000 (21:30 +0100)
committer Paul Evans <leonerd@leonerd.org.uk>
Wed, 26 Jan 2022 21:02:05 +0000 (21:02 +0000)
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;
  }
author	Paul "LeoNerd" Evans <leonerd@leonerd.org.uk>
	Tue, 14 Sep 2021 20:30:42 +0000 (21:30 +0100)
committer	Paul Evans <leonerd@leonerd.org.uk>
	Wed, 26 Jan 2022 21:02:05 +0000 (21:02 +0000)
ext/XS-APItest/Makefile.PL		patch \| blob \| blame \| history
ext/XS-APItest/t/sv_numeq.t		patch \| blob \| blame \| history
sv.c		patch \| blob \| blame \| history