#define CvROOT(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_root_u.xcv_root
#define CvXSUB(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_root_u.xcv_xsub
#define CvXSUBANY(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_start_u.xcv_xsubany
-#define CvGV(sv) S_CvGV((const CV *)(sv))
+#define CvGV(sv) S_CvGV(aTHX_ (CV *)(sv))
#define CvGV_set(cv,gv) Perl_cvgv_set(aTHX_ cv, gv)
+#define CvHASGV(cv) cBOOL(SvANY(cv)->xcv_gv_u.xcv_gv)
#define CvFILE(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_file
#ifdef USE_ITHREADS
# define CvFILE_set_from_cop(sv, cop) \
/* Flags for newXS_flags */
#define XS_DYNAMIC_FILENAME 0x01 /* The filename isn't static */
-PERL_STATIC_INLINE GV *
-S_CvGV(const CV *sv)
-{
- return CvNAMED(sv)
- ? 0
- : ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_gv_u.xcv_gv;
-}
PERL_STATIC_INLINE HEK *
CvNAME_HEK(CV *sv)
{
: Used in scope.c
pMox |GP * |newGP |NN GV *const gv
pX |void |cvgv_set |NN CV* cv|NULLOK GV* gv
+poX |GV * |cvgv_from_hek |NN CV* cv
pX |void |cvstash_set |NN CV* cv|NULLOK HV* stash
Amd |void |gv_init |NN GV* gv|NULLOK HV* stash \
|NN const char* name|STRLEN len|int multi
my $cv = B::svref_2object(\&bar);
ok($cv, "make a B::CV from a lexical sub reference");
isa_ok($cv, "B::CV");
- my $gv = $cv->GV;
- isa_ok($gv, "B::SPECIAL", "GV on a lexical sub");
my $hek = $cv->NAME_HEK;
is($hek, "bar", "check the NAME_HEK");
+ my $gv = $cv->GV;
+ isa_ok($gv, "B::GV", "GV on a lexical sub");
}
1;
EOS
void
Perl_cvgv_set(pTHX_ CV* cv, GV* gv)
{
- GV * const oldgv = CvGV(cv);
+ GV * const oldgv = CvNAMED(cv) ? NULL : SvANY(cv)->xcv_gv_u.xcv_gv;
HEK *hek;
PERL_ARGS_ASSERT_CVGV_SET;
}
}
+/* Convert CvSTASH + CvNAME_HEK into a GV. Conceptually, all subs have a
+ GV, but for efficiency that GV may not in fact exist. This function,
+ called by CvGV, reifies it. */
+
+GV *
+Perl_cvgv_from_hek(pTHX_ CV *cv)
+{
+ GV *gv;
+ PERL_ARGS_ASSERT_CVGV_FROM_HEK;
+ assert(SvTYPE(cv) == SVt_PVCV);
+ if (!CvSTASH(cv)) return NULL;
+ ASSUME(CvNAME_HEK(cv));
+ gv = (GV *)newSV(0);
+ gv_init_pvn(gv, CvSTASH(cv), HEK_KEY(CvNAME_HEK(cv)),
+ HEK_LEN(CvNAME_HEK(cv)),
+ SVf_UTF8 * !!HEK_UTF8(CvNAME_HEK(cv)));
+ unshare_hek(CvNAME_HEK(cv));
+ CvNAMED_off(cv);
+ SvANY(cv)->xcv_gv_u.xcv_gv = gv;
+ CvCVGV_RC_on(cv);
+ return gv;
+}
+
/* Assign CvSTASH(cv) = st, handling weak references. */
void
/* ------------------------------- cv.h ------------------------------- */
+PERL_STATIC_INLINE GV *
+S_CvGV(pTHX_ CV *sv)
+{
+ return CvNAMED(sv)
+ ? Perl_cvgv_from_hek(aTHX_ sv)
+ : ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_gv_u.xcv_gv;
+}
+
PERL_STATIC_INLINE I32 *
S_CvDEPTHp(const CV * const sv)
{
if (SvTYPE((SV*)cv) != SVt_PVCV)
return NULL;
if (flags & RV2CVOPCV_RETURN_NAME_GV) {
- if (!CvANON(cv) || !gv)
+ if ((!CvANON(cv) || !gv) && !CvLEXICAL(cv))
gv = CvGV(cv);
return (CV*)gv;
} else {
SV* sub_name;
/* anonymous or undef'd function leaves us no recourse */
- if (CvANON(cv) || !(gv = CvGV(cv))) {
- if (CvNAMED(cv))
- DIE(aTHX_ "Undefined subroutine &%"HEKf" called",
- HEKfARG(CvNAME_HEK(cv)));
+ if (CvLEXICAL(cv) && CvHASGV(cv))
+ DIE(aTHX_ "Undefined subroutine &%"SVf" called",
+ SVfARG(cv_name(cv, NULL)));
+ if (CvANON(cv) || !CvHASGV(cv)) {
DIE(aTHX_ "Undefined subroutine called");
}
/* autoloaded stub? */
- if (cv != GvCV(gv)) {
+ if (cv != GvCV(gv = CvGV(cv))) {
cv = GvCV(gv);
}
/* should call AUTOLOAD now? */
#define PERL_ARGS_ASSERT_CV_UNDEF \
assert(cv)
+PERL_CALLCONV GV * Perl_cvgv_from_hek(pTHX_ CV* cv)
+ __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_CVGV_FROM_HEK \
+ assert(cv)
+
PERL_CALLCONV void Perl_cvgv_set(pTHX_ CV* cv, GV* gv)
__attribute__nonnull__(pTHX_1);
#define PERL_ARGS_ASSERT_CVGV_SET \
void
Perl_croak_xs_usage(const CV *const cv, const char *const params)
{
- const GV *const gv = CvGV(cv);
+ /* Avoid CvGV as it requires aTHX. */
+ const GV *const gv = CvNAMED(cv) ? NULL : cv->sv_any->xcv_gv_u.xcv_gv;
PERL_ARGS_ASSERT_CROAK_XS_USAGE;