Add mg_findext

diff --git a/embed.fnc b/embed.fnc
index cee3c23..cca7a78 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -727,6 +727,7 @@ Apd |int    |mg_copy        |NN SV *sv|NN SV *nsv|NULLOK const char *key \
 : Defined in mg.c, used only in scope.c
 pd     |void   |mg_localize    |NN SV* sv|NN SV* nsv|bool setmagic
 ApdR   |MAGIC* |mg_find        |NULLOK const SV* sv|int type
+ApdR   |MAGIC* |mg_findext     |NULLOK const SV* sv|int type|NULLOK const MGVTBL *vtbl
 Apd    |int    |mg_free        |NN SV* sv
 Apd    |void   |mg_free_type   |NN SV* sv|int how
 Apd    |int    |mg_get         |NN SV* sv

diff --git a/embed.h b/embed.h
index b18ba5c..85ec05c 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -278,6 +278,7 @@
 #define mg_clear(a)            Perl_mg_clear(aTHX_ a)
 #define mg_copy(a,b,c,d)       Perl_mg_copy(aTHX_ a,b,c,d)
 #define mg_find(a,b)           Perl_mg_find(aTHX_ a,b)
+#define mg_findext(a,b,c)      Perl_mg_findext(aTHX_ a,b,c)
 #define mg_free(a)             Perl_mg_free(aTHX_ a)
 #define mg_free_type(a,b)      Perl_mg_free_type(aTHX_ a,b)
 #define mg_get(a)              Perl_mg_get(aTHX_ a)

diff --git a/global.sym b/global.sym
index 4aaa59e..3831f00 100644 (file)
--- a/global.sym
+++ b/global.sym
@@ -311,6 +311,7 @@ Perl_mfree
 Perl_mg_clear
 Perl_mg_copy
 Perl_mg_find
+Perl_mg_findext
 Perl_mg_free
 Perl_mg_free_type
 Perl_mg_get

diff --git a/mg.c b/mg.c
index e734d80..39f07f5 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -416,6 +416,26 @@ Perl_mg_clear(pTHX_ SV *sv)
     return 0;
 }
 
+MAGIC*
+S_mg_findext_flags(pTHX_ const SV *sv, int type, const MGVTBL *vtbl, U32 flags)
+{
+    PERL_UNUSED_CONTEXT;
+
+    assert(flags <= 1);
+
+    if (sv) {
+       MAGIC *mg;
+
+       for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
+           if (mg->mg_type == type && (!flags || mg->mg_virtual == vtbl)) {
+               return mg;
+           }
+       }
+    }
+
+    return NULL;
+}
+
 /*
 =for apidoc mg_find
 
@@ -427,15 +447,22 @@ Finds the magic pointer for type matching the SV.  See C<sv_magic>.
 MAGIC*
 Perl_mg_find(pTHX_ const SV *sv, int type)
 {
-    PERL_UNUSED_CONTEXT;
-    if (sv) {
-        MAGIC *mg;
-        for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
-            if (mg->mg_type == type)
-                return mg;
-        }
-    }
-    return NULL;
+    return S_mg_findext_flags(aTHX_ sv, type, NULL, 0);
+}
+
+/*
+=for apidoc mg_findext
+
+Finds the magic pointer of C<type> with the given C<vtbl> for the C<SV>.  See
+C<sv_magicext>.
+
+=cut
+*/
+
+MAGIC*
+Perl_mg_findext(pTHX_ const SV *sv, int type, const MGVTBL *vtbl)
+{
+    return S_mg_findext_flags(aTHX_ sv, type, vtbl, 1);
 }
 
 /*

diff --git a/proto.h b/proto.h
index 6469297..b44a4ba 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -2208,6 +2208,9 @@ PERL_CALLCONV int Perl_mg_copy(pTHX_ SV *sv, SV *nsv, const char *key, I32 klen)
 PERL_CALLCONV MAGIC*   Perl_mg_find(pTHX_ const SV* sv, int type)
                        __attribute__warn_unused_result__;
 
+PERL_CALLCONV MAGIC*   Perl_mg_findext(pTHX_ const SV* sv, int type, const MGVTBL *vtbl)
+                       __attribute__warn_unused_result__;
+
 PERL_CALLCONV int      Perl_mg_free(pTHX_ SV* sv)
                        __attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_MG_FREE       \