GV* gv;
GV** gvp;
CV* cv;
+ const char *hvname;
/* UNIVERSAL methods should be callable without a stash */
if (!stash) {
return 0;
}
- if (!HvNAME(stash))
+ hvname = HvNAME_get(stash);
+ if (!hvname)
Perl_croak(aTHX_
"Can't use anonymous symbol table for method lookup");
if ((level > 100) || (level < -100))
Perl_croak(aTHX_ "Recursive inheritance detected while looking for method '%s' in package '%s'",
- name, HvNAME(stash));
+ name, hvname);
- DEBUG_o( Perl_deb(aTHX_ "Looking for method %s in package %s\n",name,HvNAME(stash)) );
+ DEBUG_o( Perl_deb(aTHX_ "Looking for method %s in package %s\n",name,hvname) );
gvp = (GV**)hv_fetch(stash, name, len, (level >= 0));
if (!gvp)
/* create and re-create @.*::SUPER::ISA on demand */
if (!av || !SvMAGIC(av)) {
- const char* packname = HvNAME(stash);
- STRLEN packlen = strlen(packname);
+ STRLEN packlen = HvNAMELEN_get(stash);
- if (packlen >= 7 && strEQ(packname + packlen - 7, "::SUPER")) {
+ if (packlen >= 7 && strEQ(hvname + packlen - 7, "::SUPER")) {
HV* basestash;
packlen -= 7;
- basestash = gv_stashpvn(packname, packlen, TRUE);
+ basestash = gv_stashpvn(hvname, packlen, TRUE);
gvp = (GV**)hv_fetch(basestash, "ISA", 3, FALSE);
if (gvp && (gv = *gvp) != (GV*)&PL_sv_undef && (av = GvAV(gv))) {
gvp = (GV**)hv_fetch(stash, "ISA", 3, TRUE);
if (!gvp || !(gv = *gvp))
- Perl_croak(aTHX_ "Cannot create %s::ISA", HvNAME(stash));
+ Perl_croak(aTHX_ "Cannot create %s::ISA", hvname);
if (SvTYPE(gv) != SVt_PVGV)
gv_init(gv, stash, "ISA", 3, TRUE);
SvREFCNT_dec(GvAV(gv));
if (!basestash) {
if (ckWARN(WARN_MISC))
Perl_warner(aTHX_ packWARN(WARN_MISC), "Can't locate package %"SVf" for @%s::ISA",
- sv, HvNAME(stash));
+ sv, hvname);
continue;
}
gv = gv_fetchmeth(basestash, name, len,
/* __PACKAGE__::SUPER stash should be autovivified */
stash = gv_stashpvn(SvPVX_const(tmpstr), SvCUR(tmpstr), TRUE);
DEBUG_o( Perl_deb(aTHX_ "Treating %s as %s::%s\n",
- origname, HvNAME(stash), name) );
+ origname, HvNAME_get(stash), name) );
}
else {
/* don't autovifify if ->NoSuchStash::method */
GV* vargv;
SV* varsv;
const char *packname = "";
+ STRLEN packname_len;
if (len == S_autolen && strnEQ(name, S_autoload, S_autolen))
return Nullgv;
if (stash) {
if (SvTYPE(stash) < SVt_PVHV) {
- packname = SvPV_nolen((SV*)stash);
+ packname = SvPV((SV*)stash, packname_len);
stash = Nullhv;
}
else {
- packname = HvNAME(stash);
+ packname = HvNAME_get(stash);
+ packname_len = HvNAMELEN_get(stash);
}
}
if (!(gv = gv_fetchmeth(stash, S_autoload, S_autolen, FALSE)))
gv_init(vargv, varstash, S_autoload, S_autolen, FALSE);
LEAVE;
varsv = GvSV(vargv);
- sv_setpv(varsv, packname);
+ sv_setpvn(varsv, packname, packname_len);
sv_catpvn(varsv, "::", 2);
sv_catpvn(varsv, name, len);
SvTAINTED_off(varsv);
if (!GvHV(tmpgv))
GvHV(tmpgv) = newHV();
stash = GvHV(tmpgv);
- if (!HvNAME(stash))
- HvNAME(stash) = savepv(name);
+ if (!HvNAME_get(stash))
+ Perl_hv_name_set(aTHX_ stash, name, namelen, 0);
return stash;
}
if (!(stash = GvHV(gv)))
stash = GvHV(gv) = newHV();
- if (!HvNAME(stash))
- HvNAME(stash) = savepvn(nambeg, namend - nambeg);
+ if (!HvNAME_get(stash))
+ Perl_hv_name_set(aTHX_ stash, nambeg, namend - nambeg, 0);
}
if (*namend == ':')
Perl_gv_fullname4(pTHX_ SV *sv, const GV *gv, const char *prefix, bool keepmain)
{
const char *name;
+ STRLEN namelen;
const HV * const hv = GvSTASH(gv);
if (!hv) {
SvOK_off(sv);
}
sv_setpv(sv, prefix ? prefix : "");
- name = HvNAME(hv);
- if (!name)
+ name = HvNAME_get(hv);
+ if (name) {
+ namelen = HvNAMELEN_get(hv);
+ } else {
name = "__ANON__";
+ namelen = 8;
+ }
if (keepmain || strNE(name, "main")) {
- sv_catpv(sv,name);
+ sv_catpvn(sv,name,namelen);
sv_catpvn(sv,"::", 2);
}
sv_catpvn(sv,GvNAME(gv),GvNAMELEN(gv));
#endif
Perl_warner(aTHX_ packWARN(WARN_ONCE),
"Name \"%s::%s\" used only once: possible typo",
- HvNAME(stash), GvNAME(gv));
+ HvNAME_get(stash), GvNAME(gv));
}
}
}
if (gp->gp_sv) SvREFCNT_dec(gp->gp_sv);
if (gp->gp_av) SvREFCNT_dec(gp->gp_av);
- if (gp->gp_hv) {
- if (PL_stashcache && HvNAME(gp->gp_hv))
- hv_delete(PL_stashcache,
- HvNAME(gp->gp_hv), strlen(HvNAME(gp->gp_hv)),
- G_DISCARD);
- SvREFCNT_dec(gp->gp_hv);
+ /* FIXME - another reference loop GV -> symtab -> GV ?
+ Somehow gp->gp_hv can end up pointing at freed garbage. */
+ if (gp->gp_hv && SvTYPE(gp->gp_hv) == SVt_PVHV) {
+ const char *hvname = HvNAME_get(gp->gp_hv);
+ if (PL_stashcache && hvname)
+ hv_delete(PL_stashcache, hvname, HvNAMELEN_get(gp->gp_hv),
+ G_DISCARD);
+ SvREFCNT_dec(gp->gp_hv);
}
if (gp->gp_io) SvREFCNT_dec(gp->gp_io);
if (gp->gp_cv) SvREFCNT_dec(gp->gp_cv);
return (bool)AMT_OVERLOADED(amtp);
sv_unmagic((SV*)stash, PERL_MAGIC_overload_table);
- DEBUG_o( Perl_deb(aTHX_ "Recalcing overload magic in package %s\n",HvNAME(stash)) );
+ DEBUG_o( Perl_deb(aTHX_ "Recalcing overload magic in package %s\n",HvNAME_get(stash)) );
Zero(&amt,1,AMT);
amt.was_ok_am = PL_amagic_generation;
const STRLEN l = strlen(cooky);
DEBUG_o( Perl_deb(aTHX_ "Checking overloading of `%s' in package `%.256s'\n",
- cp, HvNAME(stash)) );
+ cp, HvNAME_get(stash)) );
/* don't fill the cache while looking up!
Creation of inheritance stubs in intermediate packages may
conflict with the logic of runtime method substitution.
gv = Perl_gv_fetchmeth(aTHX_ stash, cooky, l, -1);
cv = 0;
if (gv && (cv = GvCV(gv))) {
+ const char *hvname;
if (GvNAMELEN(CvGV(cv)) == 3 && strEQ(GvNAME(CvGV(cv)), "nil")
- && strEQ(HvNAME(GvSTASH(CvGV(cv))), "overload")) {
+ && strEQ(hvname = HvNAME_get(GvSTASH(CvGV(cv))), "overload")) {
/* This is a hack to support autoloading..., while
knowing *which* methods were declared as overloaded. */
/* GvSV contains the name of the method. */
DEBUG_o( Perl_deb(aTHX_ "Resolving method `%"SVf256\
"' for overloaded `%s' in package `%.256s'\n",
- GvSV(gv), cp, HvNAME(stash)) );
+ GvSV(gv), cp, hvname) );
if (!SvPOK(GvSV(gv))
|| !(ngv = gv_fetchmethod_autoload(stash, SvPVX_const(GvSV(gv)),
FALSE)))
"in package `%.256s'",
(GvCVGEN(gv) ? "Stub found while resolving"
: "Can't resolve"),
- name, cp, HvNAME(stash));
+ name, cp, hvname);
}
cv = GvCV(gv = ngv);
}
DEBUG_o( Perl_deb(aTHX_ "Overloading `%s' in package `%.256s' via `%.256s::%.256s' \n",
- cp, HvNAME(stash), HvNAME(GvSTASH(CvGV(cv))),
+ cp, HvNAME_get(stash), HvNAME_get(GvSTASH(CvGV(cv))),
GvNAME(CvGV(cv))) );
filled = 1;
if (i < DESTROY_amg)
MAGIC *mg;
AMT *amtp;
- if (!stash || !HvNAME(stash))
+ if (!stash || !HvNAME_get(stash))
return Nullcv;
mg = mg_find((SV*)stash, PERL_MAGIC_overload_table);
if (!mg) {
"in overloaded package ":
"has no overloaded magic",
SvAMAGIC(left)?
- HvNAME(SvSTASH(SvRV(left))):
+ HvNAME_get(SvSTASH(SvRV(left))):
"",
SvAMAGIC(right)?
",\n\tright argument in overloaded package ":
? ""
: ",\n\tright argument has no overloaded magic"),
SvAMAGIC(right)?
- HvNAME(SvSTASH(SvRV(right))):
+ HvNAME_get(SvSTASH(SvRV(right))):
""));
if (amtp && amtp->fallback >= AMGfallYES) {
DEBUG_o( Perl_deb(aTHX_ "%s", SvPVX_const(msg)) );
flags & AMGf_unary? "" :
lr==1 ? " for right argument": " for left argument",
flags & AMGf_unary? " for argument" : "",
- stash ? HvNAME(stash) : "null",
+ stash ? HvNAME_get(stash) : "null",
fl? ",\n\tassignment variant used": "") );
}
#endif
projects / p5sagit/p5-mst-13.2.git / blobdiff