gv.c - rename amagic_find() to amagic_applies()

The api for amagic_find() didnt make as much as sense as we thought
at first. Most people will be using this as a predicate, and don't
care about the returned CV, so to simplify things until we can really
think this through the required API this switches it to return
a bool and renames it to amagic_applies(), as in "which amagic_applies
to this sv".

3 files changed, 74 insertions, 1 deletions

diff --git a/ext/XS-APItest/APItest.pm b/ext/XS-APItest/APItest.pm
index f3f3edacf1..821ca6530a 100644
--- a/ext/XS-APItest/APItest.pm
+++ b/ext/XS-APItest/APItest.pm
@@ -4,7 +4,7 @@ use strict;
 use warnings;
 use Carp;
 
-our $VERSION = '1.28';
+our $VERSION = '1.29';
 
 require XSLoader;
 
diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
index 585d6b38de..54b9094fb9 100644
--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@@ -1717,6 +1717,18 @@ test_uvchr_to_utf8_flags_msgs(uv, flags)
 MODULE = XS::APItest:Overload   PACKAGE = XS::APItest::Overload
 
 void
+does_amagic_apply(sv, method, flags)
+    SV *sv
+    int method
+    int flags
+    PPCODE:
+        if(Perl_amagic_applies(aTHX_ sv, method, flags))
+            XSRETURN_YES;
+        else
+            XSRETURN_NO;
+
+
+void
 amagic_deref_call(sv, what)
         SV *sv
         int what
diff --git a/ext/XS-APItest/t/overload.t b/ext/XS-APItest/t/overload.t
index e83144b7b1..53f4485e4b 100644
--- a/ext/XS-APItest/t/overload.t
+++ b/ext/XS-APItest/t/overload.t
@@ -88,4 +88,65 @@ while (my ($type, $enum) = each %types) {
     }
 }
 
+{
+    package String;
+    use overload q("")=>sub { return $_[0]->val };
+    sub is_string_amg { 1 }
+    sub val { "string" }
+}
+{
+    package Num;
+    sub is_string_amg { 1 }
+    use overload q(0+) => sub { return $_[0]->val };
+    sub val { 12345 };
+}
+{
+    package NumNoFallback;
+    sub is_string_amg { undef }
+    use overload q(0+) => sub { return $_[0]->val }, fallback=>0;
+    sub val { 1234 };
+}
+{
+    package NumWithFallback;
+    sub is_string_amg { 1 }
+    use overload q(0+)=>sub { return $_[0]->val }, fallback=>1;
+    sub val { 123456 };
+}
+{
+    package NoMethod;
+    use overload q(nomethod)=> sub { $_[0]->val };
+    sub is_string_amg { 1 }
+    sub val { return(ref($_[0])||$_[0]); };
+}
+{
+    package NoOverload;
+    sub is_string_amg { 0 }
+}
+
+
+{
+    # these should be false
+
+    my $string_amg = 0x0a;
+    my $unary= 8;
+
+    foreach my $class (
+        "String",
+        "Num",
+        "NumNoFallback",
+        "NumWithFallback",
+        "NoMethod",
+        "NoOverload",
+    ) {
+        my $item= bless {}, $class;
+        my $str= eval { "$item" };
+        my $std_str= overload::StrVal($item);
+        my $ok= does_amagic_apply($item, $string_amg, $unary);
+        my $want = $class->is_string_amg;
+        is(0+$ok, $want//0, "amagic_applies($class,string_amg,AMGf_unary) works as expected");
+        is($str, $want ? $class->val : defined ($want) ? $std_str : undef,
+            "Stringified var matches amagic_applies()");
+    }
+}
+
 done_testing;