pad_compname_type(), takes care of a clunky macro

Message-Id:  <20050419163844.GA19747@petdance.com>

p4raw-id: //depot/perl@24256

diff --git a/embed.fnc b/embed.fnc
index 13cf0ae..66fb8bf 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1367,6 +1367,7 @@ pd        |void   |do_dump_pad    |I32 level|PerlIO *file \
 pd     |void   |pad_fixup_inner_anons|PADLIST *padlist|CV *old_cv|CV *new_cv
 
 pd     |void   |pad_push       |PADLIST *padlist|int depth
+p      |HV*    |pad_compname_type|PADOFFSET po
 
 #if defined(PERL_IN_PAD_C) || defined(PERL_DECL_PROT)
 sd     |PADOFFSET|pad_findlex  |const char *name|const CV* cv|U32 seq|int warn \

diff --git a/embed.h b/embed.h
index 57deaf0..3072781 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -2093,6 +2093,9 @@
 #ifdef PERL_CORE
 #define pad_push               Perl_pad_push
 #endif
+#ifdef PERL_CORE
+#define pad_compname_type      Perl_pad_compname_type
+#endif
 #if defined(PERL_IN_PAD_C) || defined(PERL_DECL_PROT)
 #ifdef PERL_CORE
 #define pad_findlex            S_pad_findlex
@@ -4693,6 +4696,9 @@
 #ifdef PERL_CORE
 #define pad_push(a,b)          Perl_pad_push(aTHX_ a,b)
 #endif
+#ifdef PERL_CORE
+#define pad_compname_type(a)   Perl_pad_compname_type(aTHX_ a)
+#endif
 #if defined(PERL_IN_PAD_C) || defined(PERL_DECL_PROT)
 #ifdef PERL_CORE
 #define pad_findlex(a,b,c,d,e,f,g)     S_pad_findlex(aTHX_ a,b,c,d,e,f,g)

diff --git a/pad.c b/pad.c
index 9a63e3e..14649fc 100644 (file)
--- a/pad.c
+++ b/pad.c
@@ -1599,3 +1599,14 @@ Perl_pad_push(pTHX_ PADLIST *padlist, int depth)
        AvFILLp(padlist) = depth;
     }
 }
+
+
+HV *
+Perl_pad_compname_type(pTHX_ const PADOFFSET po)
+{
+    SV** const av = av_fetch(PL_comppad_name, po, FALSE);
+    if ( SvFLAGS(*av) & SVpad_TYPED ) {
+        return SvSTASH(*av);
+    }
+    return Nullhv;
+}

diff --git a/pad.h b/pad.h
index 20ab331..b331cea 100644 (file)
--- a/pad.h
+++ b/pad.h
@@ -216,10 +216,7 @@ ling pad (lvalue) to C<gen>.  Note that C<SvCUR_set> is hijacked for this purpos
 #define PAD_COMPNAME_FLAGS(po) SvFLAGS(*av_fetch(PL_comppad_name, (po), FALSE))
 #define PAD_COMPNAME_PV(po) SvPV_nolen(*av_fetch(PL_comppad_name, (po), FALSE))
 
-/* XXX DAPM yuk - using av_fetch twice. Is there a better way? */
-#define PAD_COMPNAME_TYPE(po) \
-    ((SvFLAGS(*av_fetch(PL_comppad_name, (po), FALSE)) & SVpad_TYPED) \
-    ? (SvSTASH(*av_fetch(PL_comppad_name, (po), FALSE))) :  Nullhv)
+#define PAD_COMPNAME_TYPE(po) pad_compname_type(po)
 
 #define PAD_COMPNAME_OURSTASH(po) \
     (GvSTASH(*av_fetch(PL_comppad_name, (po), FALSE)))

diff --git a/proto.h b/proto.h
index 627b25e..0866d7d 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -1310,6 +1310,7 @@ PERL_CALLCONV void        Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padl
 PERL_CALLCONV void     Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv);
 
 PERL_CALLCONV void     Perl_pad_push(pTHX_ PADLIST *padlist, int depth);
+PERL_CALLCONV HV*      Perl_pad_compname_type(pTHX_ PADOFFSET po);
 
 #if defined(PERL_IN_PAD_C) || defined(PERL_DECL_PROT)
 STATIC PADOFFSET       S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn, SV** out_capture, SV** out_name_sv, int *out_flags);