pad_compname_type(), takes care of a clunky macro

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

p4raw-id: //depot/perl@24256

5 files changed, 20 insertions, 4 deletions

diff --git a/embed.fnc b/embed.fnc
index 13cf0ae3ea..66fb8bf6eb 100644
--- 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 57deaf092e..307278149f 100644
--- 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 9a63e3e83f..14649fcaa4 100644
--- 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 20ab331139..b331ceab34 100644
--- 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 627b25e3db..0866d7dc41 100644
--- 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);