void
Perl_do_hv_dump(pTHX_ I32 level, PerlIO *file, char *name, HV *sv)
{
+ const char *hvname;
Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
- if (sv && HvNAME(sv))
- PerlIO_printf(file, "\t\"%s\"\n", HvNAME(sv));
+ if (sv && (hvname = HvNAME_get(sv)))
+ PerlIO_printf(file, "\t\"%s\"\n", hvname);
else
PerlIO_putc(file, '\n');
}
{
Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
if (sv && GvNAME(sv)) {
+ const char *hvname;
PerlIO_printf(file, "\t\"");
- if (GvSTASH(sv) && HvNAME(GvSTASH(sv)))
- PerlIO_printf(file, "%s\" :: \"", HvNAME(GvSTASH(sv)));
+ if (GvSTASH(sv) && (hvname = HvNAME_get(GvSTASH(sv))))
+ PerlIO_printf(file, "%s\" :: \"", hvname);
PerlIO_printf(file, "%s\"\n", GvNAME(sv));
}
else
Perl_dump_indent(aTHX_ level, file, " KEYS = %"IVdf"\n", (IV)HvKEYS(sv));
Perl_dump_indent(aTHX_ level, file, " FILL = %"IVdf"\n", (IV)HvFILL(sv));
Perl_dump_indent(aTHX_ level, file, " MAX = %"IVdf"\n", (IV)HvMAX(sv));
- Perl_dump_indent(aTHX_ level, file, " RITER = %"IVdf"\n", (IV)HvRITER(sv));
- Perl_dump_indent(aTHX_ level, file, " EITER = 0x%"UVxf"\n", PTR2UV(HvEITER(sv)));
+ Perl_dump_indent(aTHX_ level, file, " RITER = %"IVdf"\n", (IV)HvRITER_get(sv));
+ Perl_dump_indent(aTHX_ level, file, " EITER = 0x%"UVxf"\n", PTR2UV(HvEITER_get(sv)));
if (HvPMROOT(sv))
Perl_dump_indent(aTHX_ level, file, " PMROOT = 0x%"UVxf"\n", PTR2UV(HvPMROOT(sv)));
- if (HvNAME(sv))
- Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n", HvNAME(sv));
- if (nest < maxnest && !HvEITER(sv)) { /* Try to preserve iterator */
+ {
+ const char *hvname = HvNAME_get(sv);
+ if (hvname)
+ Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n", hvname);
+ }
+ if (nest < maxnest && !HvEITER_get(sv)) { /* Try to preserve iterator */
HE *he;
HV *hv = (HV*)sv;
int count = maxnest - nest;
I32 purity, I32 deepcopy, I32 quotekeys, SV *bless,
I32 maxdepth, SV *sortkeys);
+#ifndef HvNAME_get
+#define HvNAME_get HvNAME
+#endif
+
#if PERL_VERSION <= 6 /* Perl 5.6 and earlier */
# ifdef EBCDIC
(void) sprintf(id, "0x%"UVxf, PTR2UV(ival));
idlen = strlen(id);
if (SvOBJECT(ival))
- realpack = HvNAME(SvSTASH(ival));
+ realpack = HvNAME_get(SvSTASH(ival));
else
realpack = Nullch;
GV *gv = cv ? CvGV(cv) : NULL;
if (cv && gv) {
warn("XS DBsub(%s::%s)\n",
- ((GvSTASH(gv) && HvNAME(GvSTASH(gv))) ?
- HvNAME(GvSTASH(gv)) : "(null)"),
+ ((GvSTASH(gv) && HvNAME_get(GvSTASH(gv))) ?
+ HvNAME_get(GvSTASH(gv)) : "(null)"),
GvNAME(gv));
} else {
warn("XS DBsub(unknown) at %x", Sub);
cv = db_get_cv(aTHX_ Sub);
gv = CvGV(cv);
- pname = ((GvSTASH(gv) && HvNAME(GvSTASH(gv)))
- ? HvNAME(GvSTASH(gv))
- : (char *) "(null)");
+ pname = GvSTASH(gv) ? HvNAME_get(GvSTASH(gv)) : 0;
+ pname = pname ? pname : (char *) "(null)";
gname = GvNAME(gv);
set_cv_key(aTHX_ cv, pname, gname);
hv = gv_stashpv(Package, GV_ADDWARN); /* should exist already */
- if (strNE(HvNAME(hv),"main")) {
- Safefree(HvNAME(hv));
- HvNAME(hv) = savepv("main"); /* make it think it's in main:: */
+ if (strNE(HvNAME_get(hv),"main")) {
+ /* make it think it's in main:: */
+ hv_name_set(hv, "main", 4, 0);
hv_store(hv,"_",1,(SV *)PL_defgv,0); /* connect _ to global */
SvREFCNT_inc((SV *)PL_defgv); /* want to keep _ around! */
}
{
GV *gv = gv_fetchmeth(s->stash, method, strlen(method), 0);
#if 0
- Perl_warn(aTHX_ "Lookup %s::%s => %p", HvNAME(s->stash), method, gv);
+ Perl_warn(aTHX_ "Lookup %s::%s => %p", HvNAME_get(s->stash), method, gv);
#endif
if (gv) {
return *save = GvCV(gv);
}
if (*PerlIONext(f)) {
if (!s->fh) {
- GV *gv = newGVgen(HvNAME(s->stash));
+ GV *gv = newGVgen(HvNAME_get(s->stash));
GvIOp(gv) = newIO();
s->fh = newRV_noinc((SV *) gv);
s->io = GvIOp(gv);
#define dVAR dNOOP
#endif
+#ifndef HvRITER_set
+# define HvRITER_set(hv,r) (*HvRITER(hv) = r)
+#endif
+#ifndef HvEITER_set
+# define HvEITER_set(hv,r) (*HvEITER(hv) = r)
+#endif
+
+#ifndef HvRITER_get
+# define HvRITER_get HvRITER
+#endif
+#ifndef HvEITER_get
+# define HvEITER_get HvEITER
+#endif
+
+#ifndef HvNAME_get
+#define HvNAME_get HvNAME
+#endif
+
#ifdef DEBUGME
#ifndef DASSERT
{
GV *gv;
SV *sv;
+ const char *hvname = HvNAME_get(pkg);
+
/*
* The following code is the same as the one performed by UNIVERSAL::can
gv = gv_fetchmethod_autoload(pkg, method, FALSE);
if (gv && isGV(gv)) {
sv = newRV((SV*) GvCV(gv));
- TRACEME(("%s->%s: 0x%"UVxf, HvNAME(pkg), method, PTR2UV(sv)));
+ TRACEME(("%s->%s: 0x%"UVxf, hvname, method, PTR2UV(sv)));
} else {
sv = newSVsv(&PL_sv_undef);
- TRACEME(("%s->%s: not found", HvNAME(pkg), method));
+ TRACEME(("%s->%s: not found", hvname, method));
}
/*
* it just won't be cached.
*/
- (void) hv_store(cache, HvNAME(pkg), strlen(HvNAME(pkg)), sv, 0);
+ (void) hv_store(cache, hvname, strlen(hvname), sv, 0);
return SvOK(sv) ? sv : (SV *) 0;
}
HV *pkg,
char *method)
{
+ const char *hvname = HvNAME_get(pkg);
(void) hv_store(cache,
- HvNAME(pkg), strlen(HvNAME(pkg)), newSVsv(&PL_sv_undef), 0);
+ hvname, strlen(hvname), newSVsv(&PL_sv_undef), 0);
}
/*
HV *pkg,
char *method)
{
- (void) hv_delete(cache, HvNAME(pkg), strlen(HvNAME(pkg)), G_DISCARD);
+ const char *hvname = HvNAME_get(pkg);
+ (void) hv_delete(cache, hvname, strlen(hvname), G_DISCARD);
}
/*
{
SV **svh;
SV *sv;
+ const char *hvname = HvNAME_get(pkg);
- TRACEME(("pkg_can for %s->%s", HvNAME(pkg), method));
+ TRACEME(("pkg_can for %s->%s", hvname, method));
/*
* Look into the cache to see whether we already have determined
* that only one hook (i.e. always the same) is cached in a given cache.
*/
- svh = hv_fetch(cache, HvNAME(pkg), strlen(HvNAME(pkg)), FALSE);
+ svh = hv_fetch(cache, hvname, strlen(hvname), FALSE);
if (svh) {
sv = *svh;
if (!SvOK(sv)) {
- TRACEME(("cached %s->%s: not found", HvNAME(pkg), method));
+ TRACEME(("cached %s->%s: not found", hvname, method));
return (SV *) 0;
} else {
TRACEME(("cached %s->%s: 0x%"UVxf,
- HvNAME(pkg), method, PTR2UV(sv)));
+ hvname, method, PTR2UV(sv)));
return sv;
}
}
* Save possible iteration state via each() on that table.
*/
- riter = HvRITER(hv);
- eiter = HvEITER(hv);
+ riter = HvRITER_get(hv);
+ eiter = HvEITER_get(hv);
hv_iterinit(hv);
/*
TRACEME(("ok (hash 0x%"UVxf")", PTR2UV(hv)));
out:
- HvRITER(hv) = riter; /* Restore hash iterator state */
- HvEITER(hv) = eiter;
+ HvRITER_set(hv, riter); /* Restore hash iterator state */
+ HvEITER_set(hv, eiter);
return ret;
}
char mtype = '\0'; /* for blessed ref to tied structures */
unsigned char eflags = '\0'; /* used when object type is SHT_EXTRA */
- TRACEME(("store_hook, classname \"%s\", tagged #%d", HvNAME(pkg), cxt->tagnum));
+ TRACEME(("store_hook, classname \"%s\", tagged #%d", HvNAME_get(pkg), cxt->tagnum));
/*
* Determine object type on 2 bits.
}
flags = SHF_NEED_RECURSE | obj_type;
- classname = HvNAME(pkg);
+ classname = HvNAME_get(pkg);
len = strlen(classname);
/*
char *classname;
I32 classnum;
- TRACEME(("store_blessed, type %d, class \"%s\"", type, HvNAME(pkg)));
+ TRACEME(("store_blessed, type %d, class \"%s\"", type, HvNAME_get(pkg)));
/*
* Look for a hook for this blessed SV and redirect to store_hook()
* This is a blessed SV without any serialization hook.
*/
- classname = HvNAME(pkg);
+ classname = HvNAME_get(pkg);
len = strlen(classname);
TRACEME(("blessed 0x%"UVxf" in %s, no hook: tagged #%d",
}
if (!Gv_AMG(stash)) {
SV *psv = newSVpvn("require ", 8);
- const char *package = HvNAME(stash);
+ const char *package = HvNAME_get(stash);
sv_catpv(psv, package);
TRACEME(("No overloading defined for package %s", package));
sv_setsv_nomg(SHAREDSvPTR(shared), tmp);
SvREFCNT_dec(tmp);
if(SvOBJECT(SvRV(sv))) {
- SV* fake_stash = newSVpv(HvNAME(SvSTASH(SvRV(sv))),0);
+ SV* fake_stash = newSVpv(HvNAME_get(SvSTASH(SvRV(sv))),0);
SvOBJECT_on(SHAREDSvPTR(target));
SvSTASH_set(SHAREDSvPTR(target), (HV*)fake_stash);
}
SHARED_CONTEXT;
sv_setsv_nomg(SHAREDSvPTR(shared), sv);
if(SvOBJECT(sv)) {
- SV* fake_stash = newSVpv(HvNAME(SvSTASH(sv)),0);
+ SV* fake_stash = newSVpv(HvNAME_get(SvSTASH(sv)),0);
SvOBJECT_on(SHAREDSvPTR(shared));
SvSTASH_set(SHAREDSvPTR(shared), (HV*)fake_stash);
}
ENTER_LOCK;
SHARED_CONTEXT;
{
- SV* fake_stash = newSVpv(HvNAME(stash),0);
+ SV* fake_stash = newSVpv(HvNAME_get(stash),0);
(void)sv_bless(SHAREDSvPTR(shared),(HV*)fake_stash);
}
CALLER_CONTEXT;
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 = strlen(hvname);
- 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 */
stash = Nullhv;
}
else {
- packname = HvNAME(stash);
+ packname = HvNAME_get(stash);
}
}
if (!(gv = gv_fetchmeth(stash, S_autoload, S_autolen, FALSE)))
if (!GvHV(tmpgv))
GvHV(tmpgv) = newHV();
stash = GvHV(tmpgv);
- if (!HvNAME(stash))
- HvNAME(stash) = savepv(name);
+ if (!HvNAME_get(stash))
+ hv_name_set(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))
+ hv_name_set(stash, nambeg, namend - nambeg, 0);
}
if (*namend == ':')
}
sv_setpv(sv, prefix ? prefix : "");
- name = HvNAME(hv);
+ name = HvNAME_get(hv);
if (!name)
name = "__ANON__";
#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) {
+ /* FIXME strlen HvNAME */
+ const char *hvname = HvNAME_get(gp->gp_hv);
+ if (PL_stashcache && hvname)
+ hv_delete(PL_stashcache, hvname, strlen(hvname), 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
else {
/* Iterate over ohv, copying keys and values one at a time. */
HE *entry;
- I32 riter = HvRITER(ohv);
- HE *eiter = HvEITER(ohv);
+ const I32 riter = HvRITER_get(ohv);
+ HE * const eiter = HvEITER_get(ohv);
/* Can we use fewer buckets? (hv_max is always 2^n-1) */
while (hv_max && hv_max + 1 >= hv_fill * 2)
newSVsv(HeVAL(entry)), HeHASH(entry),
HeKFLAGS(entry));
}
- HvRITER(ohv) = riter;
- HvEITER(ohv) = eiter;
+ HvRITER_set(ohv, riter);
+ HvEITER_set(ohv, eiter);
}
return hv;
if (!entry)
return;
val = HeVAL(entry);
- if (val && isGV(val) && GvCVu(val) && HvNAME(hv))
+ if (val && isGV(val) && GvCVu(val) && HvNAME_get(hv))
PL_sub_generation++; /* may be deletion of method from stash */
SvREFCNT_dec(val);
if (HeKLEN(entry) == HEf_SVKEY) {
{
if (!entry)
return;
- if (isGV(HeVAL(entry)) && GvCVu(HeVAL(entry)) && HvNAME(hv))
+ if (isGV(HeVAL(entry)) && GvCVu(HeVAL(entry)) && HvNAME_get(hv))
PL_sub_generation++; /* may be deletion of method from stash */
sv_2mortal(HeVAL(entry)); /* free between statements */
if (HeKLEN(entry) == HEf_SVKEY) {
HvHASKFLAGS_off(hv);
HvREHASH_off(hv);
reset:
- HvEITER(hv) = NULL;
+ HvEITER_set(hv, NULL);
}
/*
*oentry = HeNEXT(entry);
if (first && !*oentry)
HvFILL(hv)--; /* This linked list is now empty. */
- if (HvEITER(hv))
+ if (HvEITER_get(hv))
HvLAZYDEL_on(hv);
else
hv_free_ent(hv, entry);
Perl_hv_undef(pTHX_ HV *hv)
{
register XPVHV* xhv;
+ const char *name;
if (!hv)
return;
xhv = (XPVHV*)SvANY(hv);
hfreeentries(hv);
Safefree(xhv->xhv_array /* HvARRAY(hv) */);
- if (HvNAME(hv)) {
+ if ((name = HvNAME_get(hv))) {
+ /* FIXME - strlen HvNAME */
if(PL_stashcache)
- hv_delete(PL_stashcache, HvNAME(hv), strlen(HvNAME(hv)), G_DISCARD);
- Safefree(HvNAME(hv));
- HvNAME(hv) = 0;
+ hv_delete(PL_stashcache, name, strlen(name), G_DISCARD);
+ hv_name_set(hv, 0, 0, 0);
}
xhv->xhv_max = 7; /* HvMAX(hv) = 7 (it's a normal hash) */
xhv->xhv_array = 0; /* HvARRAY(hv) = 0 */
#define HvFILL(hv) ((XPVHV*) SvANY(hv))->xhv_fill
#define HvMAX(hv) ((XPVHV*) SvANY(hv))->xhv_max
#define HvRITER(hv) ((XPVHV*) SvANY(hv))->xhv_riter
+#define HvRITER_get(hv) ((XPVHV*) SvANY(hv))->xhv_riter
+#define HvRITER_set(hv,r) (HvRITER(hv) = r)
#define HvEITER(hv) ((XPVHV*) SvANY(hv))->xhv_eiter
+#define HvEITER_get(hv) ((XPVHV*) SvANY(hv))->xhv_eiter
+#define HvEITER_set(hv,e) (HvEITER(hv) = e)
#define HvPMROOT(hv) ((XPVHV*) SvANY(hv))->xhv_pmroot
#define HvNAME(hv) ((XPVHV*) SvANY(hv))->xhv_name
+/* FIXME - all of these should use a UTF8 aware API, which should also involve
+ getting the length. */
+#define HvNAME_get(hv) ((XPVHV*) SvANY(hv))->xhv_name
+#define hv_name_set(hv,name,length,flags) \
+ (HvNAME((hv)) = (name) ? savepvn(name, length) : 0)
/* the number of keys (including any placeholers) */
#define XHvTOTALKEYS(xhv) ((xhv)->xhv_keys)
/* available as a function in hv.c */
#define Perl_sharepvn(sv, len, hash) HEK_KEY(share_hek(sv, len, hash))
#define sharepvn(sv, len, hash) Perl_sharepvn(sv, len, hash)
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: t
+ * End:
+ *
+ * ex: set ts=8 sts=4 sw=4 noet:
+ */
if (!gv_fetchmethod_autoload(pkg, "SCALAR", FALSE)) {
SV *key;
- if (HvEITER(hv))
+ if (HvEITER_get(hv))
/* we are in an iteration so the hash cannot be empty */
return &PL_sv_yes;
/* no xhv_eiter so now use FIRSTKEY */
key = sv_newmortal();
magic_nextpack((SV*)hv, mg, key);
- HvEITER(hv) = NULL; /* need to reset iterator */
+ HvEITER_set(hv, NULL); /* need to reset iterator */
return SvOK(key) ? &PL_sv_yes : &PL_sv_no;
}
ENTER; /* need to protect against side-effects of 'use' */
SAVEINT(PL_expect);
if (stash)
- stashsv = newSVpv(HvNAME(stash), 0);
+ stashsv = newSVpv(HvNAME_get(stash), 0);
else
stashsv = &PL_sv_no;
/* Build up the real arg-list. */
if (stash)
- stashsv = newSVpv(HvNAME(stash), 0);
+ stashsv = newSVpv(HvNAME_get(stash), 0);
else
stashsv = &PL_sv_no;
arg = newOP(OP_PADSV, 0);
else if (CvROOT(cv) || CvXSUB(cv) || GvASSUMECV(gv)) {
/* already defined (or promised) */
if (ckWARN(WARN_REDEFINE) && !(CvGV(cv) && GvSTASH(CvGV(cv))
- && strEQ(HvNAME(GvSTASH(CvGV(cv))), "autouse"))) {
+ && strEQ(HvNAME_get(GvSTASH(CvGV(cv))), "autouse"))) {
const line_t oldline = CopLINE(PL_curcop);
if (PL_copline != NOLINE)
CopLINE_set(PL_curcop, PL_copline);
SvUTF8(*svp) ? -(I32)keylen : keylen, FALSE);
if (!indsvp) {
Perl_croak(aTHX_ "No such pseudo-hash field \"%s\" in variable %s of type %s",
- key, SvPV(lexname, n_a), HvNAME(SvSTASH(lexname)));
+ key, SvPV(lexname, n_a), HvNAME_get(SvSTASH(lexname)));
}
ind = SvIV(*indsvp);
if (ind < 1)
if (!indsvp) {
Perl_croak(aTHX_ "No such pseudo-hash field \"%s\" "
"in variable %s of type %s",
- key, SvPV(lexname, n_a), HvNAME(SvSTASH(lexname)));
+ key, SvPV(lexname, n_a), HvNAME_get(SvSTASH(lexname)));
}
ind = SvIV(*indsvp);
if (ind < 1)
if (items != 0) {
#if 0
Perl_croak(aTHX_ "usage: %s::%s()",
- HvNAME(GvSTASH(CvGV(cv))), GvNAME(CvGV(cv)));
+ HvNAME_get(GvSTASH(CvGV(cv))), GvNAME(CvGV(cv)));
#endif
}
EXTEND(sp, 1);
# define PmopSTASHPV_set(o,pv) (PmopSTASHPV(o) = savesharedpv(pv))
# define PmopSTASH(o) (PmopSTASHPV(o) \
? gv_stashpv(PmopSTASHPV(o),GV_ADD) : Nullhv)
-# define PmopSTASH_set(o,hv) PmopSTASHPV_set(o, ((hv) ? HvNAME(hv) : Nullch))
+# define PmopSTASH_set(o,hv) PmopSTASHPV_set(o, ((hv) ? HvNAME_get(hv) : Nullch))
# define PmopSTASH_free(o) PerlMemShared_free(PmopSTASHPV(o))
#else
# define PmopSTASH(o) ((o)->op_pmstash)
# define PmopSTASH_set(o,hv) ((o)->op_pmstash = (hv))
-# define PmopSTASHPV(o) (PmopSTASH(o) ? HvNAME(PmopSTASH(o)) : Nullch)
+# define PmopSTASHPV(o) (PmopSTASH(o) ? HvNAME_get(PmopSTASH(o)) : Nullch)
/* op_pmstash is not refcounted */
# define PmopSTASHPV_set(o,pv) PmopSTASH_set((o), gv_stashpv(pv,GV_ADD))
# define PmopSTASH_free(o)
SvREFCNT_dec(GvHV(gv));
GvHV(gv) = (HV*)SvREFCNT_inc(PL_defstash);
SvREADONLY_on(gv);
- HvNAME(PL_defstash) = savepv("main");
+ hv_name_set(PL_defstash, "main", 4, 0);
PL_incgv = gv_HVadd(gv_AVadd(gv_fetchpv("INC",TRUE, SVt_PVAV)));
GvMULTI_on(PL_incgv);
PL_hintgv = gv_fetchpv("\010",TRUE, SVt_PV); /* ^H */
break;
case 'P':
if (strEQ(elem2, "ACKAGE")) {
- const char *name = HvNAME(GvSTASH(gv));
+ const char *name = HvNAME_get(GvSTASH(gv));
sv = newSVpv(name ? name : "__ANON__", 0);
}
break;
RETURN;
}
if (PL_op->op_private & OPpLVAL_INTRO) {
- if (HvNAME(hv) && isGV(*svp))
+ if (HvNAME_get(hv) && isGV(*svp))
save_gp((GV*)*svp, !(PL_op->op_flags & OPf_SPECIAL));
else {
if (!preeminent) {
if (!sep || ((sep - name) == 5 && strnEQ(name, "SUPER", 5))) {
/* the method name is unqualified or starts with SUPER:: */
packname = sep ? CopSTASHPV(PL_curcop) :
- stash ? HvNAME(stash) : packname;
+ stash ? HvNAME_get(stash) : packname;
if (!packname)
Perl_croak(aTHX_
"Can't use anonymous symbol table for method lookup");
switch(SvTYPE(varsv)) {
case SVt_PVHV:
methname = "TIEHASH";
- HvEITER((HV *)varsv) = Null(HE *);
+ HvEITER_set((HV *)varsv, 0);
break;
case SVt_PVAV:
methname = "TIEARRAY";
}
tsv = NEWSV(0,0);
if (SvOBJECT(sv)) {
- const char *name = HvNAME(SvSTASH(sv));
+ const char *name = HvNAME_get(SvSTASH(sv));
Perl_sv_setpvf(aTHX_ tsv, "%s=%s(0x%"UVxf")",
name ? name : "__ANON__" , typestr, PTR2UV(sv));
}
CvCONST(cv)
? "Constant subroutine %s::%s redefined"
: "Subroutine %s::%s redefined",
- HvNAME(GvSTASH((GV*)dstr)),
+ HvNAME_get(GvSTASH((GV*)dstr)),
GvENAME((GV*)dstr));
}
}
if (SvREFCNT(sv)) {
if (PL_in_clean_objs)
Perl_croak(aTHX_ "DESTROY created new reference to dead object '%s'",
- HvNAME(stash));
+ HvNAME_get(stash));
/* DESTROY gave object new lease on life */
return;
}
if (GvAV(gv)) {
av_clear(GvAV(gv));
}
- if (GvHV(gv) && !HvNAME(GvHV(gv))) {
+ if (GvHV(gv) && !HvNAME_get(GvHV(gv))) {
hv_clear(GvHV(gv));
#ifndef PERL_MICRO
#ifdef USE_ENVIRON_ARRAY
/* The fact that I don't need to downcast to char * everywhere, only in ?:
inside return suggests a const propagation bug in g++. */
if (ob && SvOBJECT(sv)) {
- char *name = HvNAME(SvSTASH(sv));
+ char *name = HvNAME_get(SvSTASH(sv));
return name ? name : (char *) "__ANON__";
}
else {
int
Perl_sv_isa(pTHX_ SV *sv, const char *name)
{
+ const char *hvname;
if (!sv)
return 0;
if (SvGMAGICAL(sv))
sv = (SV*)SvRV(sv);
if (!SvOBJECT(sv))
return 0;
- if (!HvNAME(SvSTASH(sv)))
+ hvname = HvNAME_get(SvSTASH(sv));
+ if (!hvname)
return 0;
- return strEQ(HvNAME(SvSTASH(sv)), name);
+ return strEQ(hvname, name);
}
/*
if (!GvUNIQUE(gv)) {
#if 0
PerlIO_printf(Perl_debug_log, "gv_share: unable to share %s::%s\n",
- HvNAME(GvSTASH(gv)), GvNAME(gv));
+ HvNAME_get(GvSTASH(gv)), GvNAME(gv));
#endif
return Nullsv;
}
if(param->flags & CLONEf_JOIN_IN) {
/** We are joining here so we don't want do clone
something that is bad **/
+ const char *hvname;
if(SvTYPE(sstr) == SVt_PVHV &&
- HvNAME(sstr)) {
+ (hvname = HvNAME_get(sstr))) {
/** don't clone stashes if they already exist **/
- HV* old_stash = gv_stashpv(HvNAME(sstr),0);
+ HV* old_stash = gv_stashpv(hvname,0);
return (SV*) old_stash;
}
}
ptr_table_store(PL_ptr_table, sstr, dstr);
#if 0
PerlIO_printf(Perl_debug_log, "sv_dup: sharing %s::%s\n",
- HvNAME(GvSTASH(share)), GvNAME(share));
+ HvNAME_get(GvSTASH(share)), GvNAME(share));
#endif
break;
}
SvNV_set(dstr, SvNVX(sstr));
SvMAGIC_set(dstr, mg_dup(SvMAGIC(sstr), param));
SvSTASH_set(dstr, hv_dup_inc(SvSTASH(sstr), param));
- HvRITER((HV*)dstr) = HvRITER((HV*)sstr);
+ HvRITER_set((HV*)dstr, HvRITER_get((HV*)sstr));
if (HvARRAY((HV*)sstr)) {
STRLEN i = 0;
XPVHV *dxhv = (XPVHV*)SvANY(dstr);
}
else {
SvPV_set(dstr, Nullch);
- HvEITER((HV*)dstr) = (HE*)NULL;
+ HvEITER_set((HV*)dstr, (HE*)NULL);
}
HvPMROOT((HV*)dstr) = HvPMROOT((HV*)sstr); /* XXX */
HvNAME((HV*)dstr) = SAVEPV(HvNAME((HV*)sstr));
- /* Record stashes for possible cloning in Perl_clone(). */
+ /* Record stashes for possible cloning in Perl_clone(). */
if(HvNAME((HV*)dstr))
av_push(param->stashes, dstr);
break;
static void
do_mark_cloneable_stash(pTHX_ SV *sv)
{
- if (HvNAME((HV*)sv)) {
+ const char *hvname = HvNAME_get((HV*)sv);
+ if (hvname) {
GV* cloner = gv_fetchmethod_autoload((HV*)sv, "CLONE_SKIP", 0);
SvFLAGS(sv) |= SVphv_CLONEABLE; /* clone objects by default */
if (cloner && GvCV(cloner)) {
ENTER;
SAVETMPS;
PUSHMARK(SP);
- XPUSHs(sv_2mortal(newSVpv(HvNAME((HV*)sv), 0)));
+ XPUSHs(sv_2mortal(newSVpv(hvname, 0)));
PUTBACK;
call_sv((SV*)GvCV(cloner), G_SCALAR);
SPAGAIN;
ENTER;
SAVETMPS;
PUSHMARK(SP);
- XPUSHs(sv_2mortal(newSVpv(HvNAME(stash), 0)));
+ XPUSHs(sv_2mortal(newSVpv(HvNAME_get(stash), 0)));
PUTBACK;
call_sv((SV*)GvCV(cloner), G_DISCARD);
FREETMPS;
case KEY___PACKAGE__:
yylval.opval = (OP*)newSVOP(OP_CONST, 0,
(PL_curstash
- ? newSVpv(HvNAME(PL_curstash), 0)
+ ? newSVpv(HvNAME_get(PL_curstash), 0)
: &PL_sv_undef));
TERM(THING);
if (PL_rsfp && (!PL_in_eval || PL_tokenbuf[2] == 'D')) {
const char *pname = "main";
if (PL_tokenbuf[2] == 'D')
- pname = HvNAME(PL_curstash ? PL_curstash : PL_defstash);
+ pname = HvNAME_get(PL_curstash ? PL_curstash : PL_defstash);
gv = gv_fetchpv(Perl_form(aTHX_ "%s::DATA", pname), TRUE, SVt_PVIO);
GvMULTI_on(gv);
if (!GvIO(gv))
/* might be an "our" variable" */
if (PAD_COMPNAME_FLAGS(tmp) & SVpad_OUR) {
/* build ops for a bareword */
- SV *sym = newSVpv(HvNAME(PAD_COMPNAME_OURSTASH(tmp)), 0);
+ SV *sym = newSVpv(HvNAME_get(PAD_COMPNAME_OURSTASH(tmp)), 0);
sv_catpvn(sym, "::", 2);
sv_catpv(sym, PL_tokenbuf+1);
yylval.opval = (OP*)newSVOP(OP_CONST, 0, sym);
if ((tmp = pad_findmy(d)) != NOT_IN_PAD) {
if (PAD_COMPNAME_FLAGS(tmp) & SVpad_OUR) {
SV *sym = sv_2mortal(
- newSVpv(HvNAME(PAD_COMPNAME_OURSTASH(tmp)),0));
+ newSVpv(HvNAME_get(PAD_COMPNAME_OURSTASH(tmp)),0));
sv_catpvn(sym, "::", 2);
sv_catpv(sym, d+1);
d = SvPVX(sym);
GV** gvp;
HV* hv = Nullhv;
SV* subgen = Nullsv;
+ const char *hvname;
/* A stash/class can go by many names (ie. User == main::User), so
we compare the stash itself just in case */
if (name_stash && (stash == name_stash))
return &PL_sv_yes;
- if (strEQ(HvNAME(stash), name))
+ hvname = HvNAME_get(stash);
+
+ if (strEQ(hvname, name))
return &PL_sv_yes;
if (strEQ(name, "UNIVERSAL"))
if (level > 100)
Perl_croak(aTHX_ "Recursive inheritance detected in package '%s'",
- HvNAME(stash));
+ hvname);
gvp = (GV**)hv_fetch(stash, "::ISA::CACHE::", 14, FALSE);
SV** svp = (SV**)hv_fetch(hv, name, len, FALSE);
if (svp && (sv = *svp) != (SV*)&PL_sv_undef) {
DEBUG_o( Perl_deb(aTHX_ "Using cached ISA %s for package %s\n",
- name, HvNAME(stash)) );
+ name, hvname) );
return sv;
}
}
else {
DEBUG_o( Perl_deb(aTHX_ "ISA Cache in package %s is stale\n",
- HvNAME(stash)) );
+ hvname) );
hv_clear(hv);
sv_setiv(subgen, PL_sub_generation);
}
if (!basestash) {
if (ckWARN(WARN_MISC))
Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
- "Can't locate package %"SVf" for @%s::ISA",
- sv, HvNAME(stash));
+ "Can't locate package %"SVf" for @%s::ISA",
+ sv, hvname);
continue;
}
if (&PL_sv_yes == isa_lookup(basestash, name, name_stash,
SV *req = ST(1);
if (undef) {
- if (pkg)
- Perl_croak(aTHX_
+ if (pkg) {
+ const char *name = HvNAME_get(pkg);
+ Perl_croak(aTHX_
"%s does not define $%s::VERSION--version check failed",
- HvNAME(pkg), HvNAME(pkg));
- else {
+ name, name);
+ } else {
const char *str = SvPVx(ST(0), len);
Perl_croak(aTHX_
if (SvNV(req) > SvNV(sv))
Perl_croak(aTHX_ "%s version %s required--this is only version %s",
- HvNAME(pkg), SvPV_nolen(req), SvPV_nolen(sv));
+ HvNAME_get(pkg), SvPV_nolen(req), SvPV_nolen(sv));
}
finish:
sv = SvRV(rv);
if (SvOBJECT(sv))
- sv_setpv(TARG, HvNAME(SvSTASH(sv)));
+ sv_setpv(TARG, HvNAME_get(SvSTASH(sv)));
#if 0 /* this was probably a bad idea */
else if (SvPADMY(sv))
sv_setsv(TARG, &PL_sv_no); /* unblessed lexical */
break;
}
if (stash)
- sv_setpv(TARG, HvNAME(stash));
+ sv_setpv(TARG, HvNAME_get(stash));
}
SvSETMAGIC(TARG);
https://perl5.git.perl.org / perl5.git / commitdiff