summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--dump.c23
-rw-r--r--embed.fnc7
-rw-r--r--ext/Data/Dumper/Dumper.xs6
-rw-r--r--ext/Devel/DProf/DProf.xs9
-rw-r--r--ext/Opcode/Opcode.xs6
-rw-r--r--ext/PerlIO/via/via.xs4
-rw-r--r--ext/Storable/Storable.xs59
-rw-r--r--ext/threads/shared/shared.xs6
-rw-r--r--global.sym6
-rw-r--r--gv.c71
-rw-r--r--hv.c205
-rw-r--r--hv.h40
-rw-r--r--mg.c4
-rw-r--r--op.c12
-rw-r--r--op.h4
-rw-r--r--perl.c2
-rw-r--r--pp.c2
-rw-r--r--pp_hot.c4
-rw-r--r--pp_sys.c2
-rw-r--r--proto.h7
-rw-r--r--sv.c96
-rw-r--r--toke.c8
-rw-r--r--universal.c26
-rw-r--r--xsutils.c4
24 files changed, 426 insertions, 187 deletions
diff --git a/dump.c b/dump.c
index f3d6657950..547af9f154 100644
--- a/dump.c
+++ b/dump.c
@@ -1060,9 +1060,10 @@ Perl_magic_dump(pTHX_ const MAGIC *mg)
void
Perl_do_hv_dump(pTHX_ I32 level, PerlIO *file, const 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');
}
@@ -1082,9 +1083,10 @@ Perl_do_gvgv_dump(pTHX_ I32 level, PerlIO *file, const char *name, GV *sv)
{
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
@@ -1420,17 +1422,20 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
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)));
{
MAGIC *mg = mg_find(sv, PERL_MAGIC_symtab);
if (mg && mg->mg_obj) {
Perl_dump_indent(aTHX_ level, file, " PMROOT = 0x%"UVxf"\n", PTR2UV(mg->mg_obj));
}
}
- 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;
diff --git a/embed.fnc b/embed.fnc
index 11c362e5a9..02b75ec483 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1397,7 +1397,12 @@ sM |HE* |hv_fetch_common|HV* tb|SV* key_sv|const char* key|STRLEN klen|int flags
Apd |void |hv_clear_placeholders|HV* hb
Apd |SV* |hv_scalar |HV* hv|
-
+Apo |I32* |hv_riter_p |HV* hv
+Apo |HE** |hv_eiter_p |HV* hv
+Apo |void |hv_riter_set |HV* hv|I32 riter
+Apo |void |hv_eiter_set |HV* hv|HE* eiter
+Apo |char** |hv_name_p |HV* hv
+Apo |void |hv_name_set |HV* hv|const char *|STRLEN len|int flags
Apo |I32* |hv_placeholders_p |HV* hv
Apo |I32 |hv_placeholders_get |HV* hv
Apo |void |hv_placeholders_set |HV* hv|I32 ph
diff --git a/ext/Data/Dumper/Dumper.xs b/ext/Data/Dumper/Dumper.xs
index ee1bc14a65..3f06b7b8f0 100644
--- a/ext/Data/Dumper/Dumper.xs
+++ b/ext/Data/Dumper/Dumper.xs
@@ -14,6 +14,10 @@ static I32 DD_dump (pTHX_ SV *val, char *name, STRLEN namelen, SV *retval,
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
@@ -281,7 +285,7 @@ DD_dump(pTHX_ SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv,
(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;
diff --git a/ext/Devel/DProf/DProf.xs b/ext/Devel/DProf/DProf.xs
index 10d4172bcd..c840b24424 100644
--- a/ext/Devel/DProf/DProf.xs
+++ b/ext/Devel/DProf/DProf.xs
@@ -42,8 +42,8 @@ dprof_dbg_sub_notify(pTHX_ SV *Sub) {
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);
@@ -371,9 +371,8 @@ prof_mark(pTHX_ opcode ptype)
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);
diff --git a/ext/Opcode/Opcode.xs b/ext/Opcode/Opcode.xs
index 067ffdb424..78c7605331 100644
--- a/ext/Opcode/Opcode.xs
+++ b/ext/Opcode/Opcode.xs
@@ -268,9 +268,9 @@ PPCODE:
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:: */
+ Perl_hv_name_set(aTHX_ hv, "main", 4, 0);
hv_store(hv,"_",1,(SV *)PL_defgv,0); /* connect _ to global */
SvREFCNT_inc((SV *)PL_defgv); /* want to keep _ around! */
}
diff --git a/ext/PerlIO/via/via.xs b/ext/PerlIO/via/via.xs
index 36394dd82b..028a298dc0 100644
--- a/ext/PerlIO/via/via.xs
+++ b/ext/PerlIO/via/via.xs
@@ -45,7 +45,7 @@ PerlIOVia_fetchmethod(pTHX_ PerlIOVia * s, char *method, CV ** save)
{
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);
@@ -87,7 +87,7 @@ PerlIOVia_method(pTHX_ PerlIO * f, char *method, CV ** save, int flags,
}
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);
diff --git a/ext/Storable/Storable.xs b/ext/Storable/Storable.xs
index 68d8e26ead..53f9543798 100644
--- a/ext/Storable/Storable.xs
+++ b/ext/Storable/Storable.xs
@@ -107,6 +107,24 @@ typedef double NV; /* Older perls lack the NV type */
#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
+
#ifndef HvPLACEHOLDERS_get
# define HvPLACEHOLDERS_get HvPLACEHOLDERS
#endif
@@ -1637,6 +1655,8 @@ static SV *pkg_fetchmeth(
{
GV *gv;
SV *sv;
+ const char *hvname = HvNAME_get(pkg);
+
/*
* The following code is the same as the one performed by UNIVERSAL::can
@@ -1646,10 +1666,10 @@ static SV *pkg_fetchmeth(
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));
}
/*
@@ -1657,7 +1677,7 @@ static SV *pkg_fetchmeth(
* 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;
}
@@ -1673,8 +1693,9 @@ static void pkg_hide(
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);
}
/*
@@ -1688,7 +1709,8 @@ static void pkg_uncache(
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);
}
/*
@@ -1707,8 +1729,9 @@ static SV *pkg_can(
{
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
@@ -1718,15 +1741,15 @@ static SV *pkg_can(
* 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;
}
}
@@ -2260,8 +2283,8 @@ static int store_hash(pTHX_ stcxt_t *cxt, HV *hv)
* 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);
/*
@@ -2529,8 +2552,8 @@ static int store_hash(pTHX_ stcxt_t *cxt, HV *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;
}
@@ -2835,7 +2858,7 @@ static int store_hook(
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.
@@ -2886,7 +2909,7 @@ static int store_hook(
}
flags = SHF_NEED_RECURSE | obj_type;
- classname = HvNAME(pkg);
+ classname = HvNAME_get(pkg);
len = strlen(classname);
/*
@@ -3254,7 +3277,7 @@ static int store_blessed(
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()
@@ -3269,7 +3292,7 @@ static int store_blessed(
* 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",
@@ -4511,7 +4534,7 @@ static SV *retrieve_overloaded(pTHX_ stcxt_t *cxt, char *cname)
}
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));
diff --git a/ext/threads/shared/shared.xs b/ext/threads/shared/shared.xs
index dcaa7e7a9e..aa1dcf2b44 100644
--- a/ext/threads/shared/shared.xs
+++ b/ext/threads/shared/shared.xs
@@ -529,7 +529,7 @@ sharedsv_scalar_store(pTHX_ SV *sv, shared_sv *shared)
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);
}
@@ -544,7 +544,7 @@ sharedsv_scalar_store(pTHX_ SV *sv, shared_sv *shared)
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);
}
@@ -1294,7 +1294,7 @@ bless(SV* ref, ...);
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;
diff --git a/global.sym b/global.sym
index c98279553c..cc938bcfb4 100644
--- a/global.sym
+++ b/global.sym
@@ -675,6 +675,12 @@ Perl_save_set_svflags
Perl_hv_assert
Perl_hv_clear_placeholders
Perl_hv_scalar
+Perl_hv_riter_p
+Perl_hv_eiter_p
+Perl_hv_riter_set
+Perl_hv_eiter_set
+Perl_hv_name_p
+Perl_hv_name_set
Perl_hv_placeholders_p
Perl_hv_placeholders_get
Perl_hv_placeholders_set
diff --git a/gv.c b/gv.c
index 5d533f0110..40a0e8d2bb 100644
--- a/gv.c
+++ b/gv.c
@@ -201,6 +201,7 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
GV* gv;
GV** gvp;
CV* cv;
+ const char *hvname;
/* UNIVERSAL methods should be callable without a stash */
if (!stash) {
@@ -209,15 +210,16 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
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)
@@ -244,19 +246,19 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
/* create and re-create @.*::SUPER::ISA on demand */
if (!av || !SvMAGIC(av)) {
- const char* packname = HvNAME(stash);
- STRLEN packlen = strlen(packname);
+ /* FIXME - get this from the symtab magic. */
+ 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));
@@ -275,7 +277,7 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
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,
@@ -435,7 +437,7 @@ Perl_gv_fetchmethod_autoload(pTHX_ HV *stash, const char *name, I32 autoload)
/* __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 */
@@ -500,7 +502,7 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method)
stash = Nullhv;
}
else {
- packname = HvNAME(stash);
+ packname = HvNAME_get(stash);
}
}
if (!(gv = gv_fetchmeth(stash, S_autoload, S_autolen, FALSE)))
@@ -629,8 +631,8 @@ Perl_gv_stashpvn(pTHX_ const char *name, U32 namelen, I32 create)
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;
}
@@ -718,8 +720,8 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
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 == ':')
@@ -1131,7 +1133,7 @@ Perl_gv_fullname4(pTHX_ SV *sv, const GV *gv, const char *prefix, bool keepmain)
}
sv_setpv(sv, prefix ? prefix : "");
- name = HvNAME(hv);
+ name = HvNAME_get(hv);
if (!name)
name = "__ANON__";
@@ -1242,7 +1244,7 @@ Perl_gv_check(pTHX_ HV *stash)
#endif
Perl_warner(aTHX_ packWARN(WARN_ONCE),
"Name \"%s::%s\" used only once: possible typo",
- HvNAME(stash), GvNAME(gv));
+ HvNAME_get(stash), GvNAME(gv));
}
}
}
@@ -1304,12 +1306,14 @@ Perl_gp_free(pTHX_ GV *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);
@@ -1354,7 +1358,7 @@ Perl_Gv_AMupdate(pTHX_ HV *stash)
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;
@@ -1390,7 +1394,7 @@ Perl_Gv_AMupdate(pTHX_ HV *stash)
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.
@@ -1404,8 +1408,9 @@ Perl_Gv_AMupdate(pTHX_ HV *stash)
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. */
@@ -1413,7 +1418,7 @@ Perl_Gv_AMupdate(pTHX_ HV *stash)
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)))
@@ -1425,12 +1430,12 @@ Perl_Gv_AMupdate(pTHX_ HV *stash)
"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)
@@ -1465,7 +1470,7 @@ Perl_gv_handler(pTHX_ HV *stash, I32 id)
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) {
@@ -1696,7 +1701,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
"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 ":
@@ -1704,7 +1709,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
? ""
: ",\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)) );
@@ -1729,7 +1734,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
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
diff --git a/hv.c b/hv.c
index c12d20ee98..4daaf331b7 100644
--- a/hv.c
+++ b/hv.c
@@ -1027,7 +1027,8 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
*oentry = HeNEXT(entry);
if (i && !*oentry)
xhv->xhv_fill--; /* HvFILL(hv)-- */
- if (entry == xhv->xhv_eiter /* HvEITER(hv) */)
+ if (xhv->xhv_aux && entry
+ == ((struct xpvhv_aux *)xhv->xhv_aux)->xhv_eiter /* HvEITER(hv) */)
HvLAZYDEL_on(hv);
else
hv_free_ent(hv, entry);
@@ -1307,7 +1308,7 @@ Perl_newHV(pTHX)
xhv->xhv_max = 7; /* HvMAX(hv) = 7 (start with 8 buckets) */
xhv->xhv_fill = 0; /* HvFILL(hv) = 0 */
- (void)hv_iterinit(hv); /* so each() will start off right */
+ xhv->xhv_aux = 0;
return hv;
}
@@ -1368,8 +1369,8 @@ Perl_newHVhv(pTHX_ HV *ohv)
else {
/* Iterate over ohv, copying keys and values one at a time. */
HE *entry;
- const I32 riter = HvRITER(ohv);
- HE * const 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)
@@ -1382,8 +1383,8 @@ Perl_newHVhv(pTHX_ HV *ohv)
newSVsv(HeVAL(entry)), HeHASH(entry),
HeKFLAGS(entry));
}
- HvRITER(ohv) = riter;
- HvEITER(ohv) = eiter;
+ HvRITER_set(ohv, riter);
+ HvEITER_set(ohv, eiter);
}
return hv;
@@ -1397,7 +1398,7 @@ Perl_hv_free_ent(pTHX_ HV *hv, register HE *entry)
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) {
@@ -1416,7 +1417,7 @@ Perl_hv_delayfree_ent(pTHX_ HV *hv, register HE *entry)
{
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) {
@@ -1485,7 +1486,9 @@ Perl_hv_clear(pTHX_ HV *hv)
HvHASKFLAGS_off(hv);
HvREHASH_off(hv);
reset:
- HvEITER(hv) = NULL;
+ if (xhv->xhv_aux) {
+ HvEITER_set(hv, NULL);
+ }
}
/*
@@ -1526,7 +1529,7 @@ Perl_hv_clear_placeholders(pTHX_ HV *hv)
*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);
@@ -1557,6 +1560,7 @@ S_hfreeentries(pTHX_ HV *hv)
register HE *entry;
I32 riter;
I32 max;
+ struct xpvhv_aux *iter;
if (!hv)
return;
@@ -1586,7 +1590,17 @@ S_hfreeentries(pTHX_ HV *hv)
}
}
HvARRAY(hv) = array;
- (void)hv_iterinit(hv);
+
+ iter = ((XPVHV*) SvANY(hv))->xhv_aux;
+ if (iter) {
+ entry = iter->xhv_eiter; /* HvEITER(hv) */
+ if (entry && HvLAZYDEL(hv)) { /* was deleted earlier? */
+ HvLAZYDEL_off(hv);
+ hv_free_ent(hv, entry);
+ }
+ Safefree(iter);
+ ((XPVHV*) SvANY(hv))->xhv_aux = 0;
+ }
}
/*
@@ -1601,17 +1615,18 @@ void
Perl_hv_undef(pTHX_ HV *hv)
{
register XPVHV* xhv;
+ const char *name;
if (!hv)
return;
DEBUG_A(Perl_hv_assert(aTHX_ hv));
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);
+ Perl_hv_name_set(aTHX_ hv, 0, 0, 0);
}
xhv->xhv_max = 7; /* HvMAX(hv) = 7 (it's a normal hash) */
xhv->xhv_array = 0; /* HvARRAY(hv) = 0 */
@@ -1621,6 +1636,19 @@ Perl_hv_undef(pTHX_ HV *hv)
mg_clear((SV*)hv);
}
+struct xpvhv_aux*
+S_hv_auxinit(aTHX) {
+ struct xpvhv_aux *iter;
+
+ New(0, iter, 1, struct xpvhv_aux);
+
+ iter->xhv_riter = -1; /* HvRITER(hv) = -1 */
+ iter->xhv_eiter = Null(HE*); /* HvEITER(hv) = Null(HE*) */
+ iter->xhv_name = 0;
+
+ return iter;
+}
+
/*
=for apidoc hv_iterinit
@@ -1641,20 +1669,120 @@ Perl_hv_iterinit(pTHX_ HV *hv)
{
register XPVHV* xhv;
HE *entry;
+ struct xpvhv_aux *iter;
if (!hv)
Perl_croak(aTHX_ "Bad hash");
xhv = (XPVHV*)SvANY(hv);
- entry = xhv->xhv_eiter; /* HvEITER(hv) */
- if (entry && HvLAZYDEL(hv)) { /* was deleted earlier? */
- HvLAZYDEL_off(hv);
- hv_free_ent(hv, entry);
+
+ iter = xhv->xhv_aux;
+ if (iter) {
+ entry = iter->xhv_eiter; /* HvEITER(hv) */
+ if (entry && HvLAZYDEL(hv)) { /* was deleted earlier? */
+ HvLAZYDEL_off(hv);
+ hv_free_ent(hv, entry);
+ }
+ iter->xhv_riter = -1; /* HvRITER(hv) = -1 */
+ iter->xhv_eiter = Null(HE*); /* HvEITER(hv) = Null(HE*) */
+ } else {
+ xhv->xhv_aux = S_hv_auxinit(aTHX);
}
- xhv->xhv_riter = -1; /* HvRITER(hv) = -1 */
- xhv->xhv_eiter = Null(HE*); /* HvEITER(hv) = Null(HE*) */
+
/* used to be xhv->xhv_fill before 5.004_65 */
return XHvTOTALKEYS(xhv);
}
+
+I32 *
+Perl_hv_riter_p(pTHX_ HV *hv) {
+ struct xpvhv_aux *iter;
+
+ if (!hv)
+ Perl_croak(aTHX_ "Bad hash");
+
+ iter = ((XPVHV *)SvANY(hv))->xhv_aux;
+ if (!iter) {
+ ((XPVHV *)SvANY(hv))->xhv_aux = iter = S_hv_auxinit(aTHX);
+ }
+ return &(iter->xhv_riter);
+}
+
+HE **
+Perl_hv_eiter_p(pTHX_ HV *hv) {
+ struct xpvhv_aux *iter;
+
+ if (!hv)
+ Perl_croak(aTHX_ "Bad hash");
+
+ iter = ((XPVHV *)SvANY(hv))->xhv_aux;
+ if (!iter) {
+ ((XPVHV *)SvANY(hv))->xhv_aux = iter = S_hv_auxinit(aTHX);
+ }
+ return &(iter->xhv_eiter);
+}
+
+void
+Perl_hv_riter_set(pTHX_ HV *hv, I32 riter) {
+ struct xpvhv_aux *iter;
+
+ if (!hv)
+ Perl_croak(aTHX_ "Bad hash");
+
+
+ iter = ((XPVHV *)SvANY(hv))->xhv_aux;
+ if (!iter) {
+ if (riter == -1)
+ return;
+
+ ((XPVHV *)SvANY(hv))->xhv_aux = iter = S_hv_auxinit(aTHX);
+ }
+ iter->xhv_riter = riter;
+}
+
+void
+Perl_hv_eiter_set(pTHX_ HV *hv, HE *eiter) {
+ struct xpvhv_aux *iter;
+
+ if (!hv)
+ Perl_croak(aTHX_ "Bad hash");
+
+ iter = ((XPVHV *)SvANY(hv))->xhv_aux;
+ if (!iter) {
+ /* 0 is the default so don't go malloc()ing a new structure just to
+ hold 0. */
+ if (!eiter)
+ return;
+
+ ((XPVHV *)SvANY(hv))->xhv_aux = iter = S_hv_auxinit(aTHX);
+ }
+ iter->xhv_eiter = eiter;
+}
+
+
+char **
+Perl_hv_name_p(pTHX_ HV *hv)
+{
+ struct xpvhv_aux *iter = ((XPVHV *)SvANY(hv))->xhv_aux;
+
+ if (!iter) {
+ ((XPVHV *)SvANY(hv))->xhv_aux = iter = S_hv_auxinit(aTHX);
+ }
+ return &(iter->xhv_name);
+}
+
+void
+Perl_hv_name_set(pTHX_ HV *hv, const char *name, STRLEN len, int flags)
+{
+ struct xpvhv_aux *iter = ((XPVHV *)SvANY(hv))->xhv_aux;
+
+ if (!iter) {
+ if (name == 0)
+ return;
+
+ ((XPVHV *)SvANY(hv))->xhv_aux = iter = S_hv_auxinit(aTHX);
+ }
+ iter->xhv_name = savepvn(name, len);
+}
+
/*
=for apidoc hv_iternext
@@ -1700,11 +1828,22 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
register HE *entry;
HE *oldentry;
MAGIC* mg;
+ struct xpvhv_aux *iter;
if (!hv)
Perl_croak(aTHX_ "Bad hash");
xhv = (XPVHV*)SvANY(hv);
- oldentry = entry = xhv->xhv_eiter; /* HvEITER(hv) */
+ iter = xhv->xhv_aux;
+
+ if (!iter) {
+ /* Too many things (well, pp_each at least) merrily assume that you can
+ call iv_iternext without calling hv_iterinit, so we'll have to deal
+ with it. */
+ hv_iterinit(hv);
+ iter = ((XPVHV *)SvANY(hv))->xhv_aux;
+ }
+
+ oldentry = entry = iter->xhv_eiter; /* HvEITER(hv) */
if ((mg = SvTIED_mg((SV*)hv, PERL_MAGIC_tied))) {
SV *key = sv_newmortal();
@@ -1717,7 +1856,7 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
HEK *hek;
/* one HE per MAGICAL hash */
- xhv->xhv_eiter = entry = new_HE(); /* HvEITER(hv) = new_HE() */
+ iter->xhv_eiter = entry = new_HE(); /* HvEITER(hv) = new_HE() */
Zero(entry, 1, HE);
Newz(54, k, HEK_BASESIZE + sizeof(SV*), char);
hek = (HEK*)k;
@@ -1734,7 +1873,7 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
SvREFCNT_dec(HeVAL(entry));
Safefree(HeKEY_hek(entry));
del_HE(entry);
- xhv->xhv_eiter = Null(HE*); /* HvEITER(hv) = Null(HE*) */
+ iter->xhv_eiter = Null(HE*); /* HvEITER(hv) = Null(HE*) */
return Null(HE*);
}
#ifdef DYNAMIC_ENV_FETCH /* set up %ENV for iteration */
@@ -1763,14 +1902,14 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
while (!entry) {
/* OK. Come to the end of the current list. Grab the next one. */
- xhv->xhv_riter++; /* HvRITER(hv)++ */
- if (xhv->xhv_riter > (I32)xhv->xhv_max /* HvRITER(hv) > HvMAX(hv) */) {
+ iter->xhv_riter++; /* HvRITER(hv)++ */
+ if (iter->xhv_riter > (I32)xhv->xhv_max /* HvRITER(hv) > HvMAX(hv) */) {
/* There is no next one. End of the hash. */
- xhv->xhv_riter = -1; /* HvRITER(hv) = -1 */
+ iter->xhv_riter = -1; /* HvRITER(hv) = -1 */
break;
}
/* entry = (HvARRAY(hv))[HvRITER(hv)]; */
- entry = ((HE**)xhv->xhv_array)[xhv->xhv_riter];
+ entry = ((HE**)xhv->xhv_array)[iter->xhv_riter];
if (!(flags & HV_ITERNEXT_WANTPLACEHOLDERS)) {
/* If we have an entry, but it's a placeholder, don't count it.
@@ -1791,7 +1930,7 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
/*if (HvREHASH(hv) && entry && !HeKREHASH(entry))
PerlIO_printf(PerlIO_stderr(), "Awooga %p %p\n", hv, entry);*/
- xhv->xhv_eiter = entry; /* HvEITER(hv) = entry */
+ iter->xhv_eiter = entry; /* HvEITER(hv) = entry */
return entry;
}
@@ -2184,8 +2323,8 @@ Perl_hv_assert(pTHX_ HV *hv)
int placeholders = 0;
int real = 0;
int bad = 0;
- const I32 riter = HvRITER(hv);
- HE *eiter = HvEITER(hv);
+ const I32 riter = HvRITER_get(hv);
+ HE *eiter = HvEITER_get(hv);
(void)hv_iterinit(hv);
@@ -2233,8 +2372,8 @@ Perl_hv_assert(pTHX_ HV *hv)
if (bad) {
sv_dump((SV *)hv);
}
- HvRITER(hv) = riter; /* Restore hash iterator state */
- HvEITER(hv) = eiter;
+ HvRITER_set(hv, riter); /* Restore hash iterator state */
+ HvEITER_set(hv, eiter);
}
/*
diff --git a/hv.h b/hv.h
index da3e0e61d6..2388113f13 100644
--- a/hv.h
+++ b/hv.h
@@ -29,6 +29,16 @@ struct hek {
is UTF-8 */
};
+
+/* Subject to change.
+ Don't access this directly.
+*/
+struct xpvhv_aux {
+ char *xhv_name; /* name, if a symbol table */
+ HE *xhv_eiter; /* current entry of iterator */
+ I32 xhv_riter; /* current root of iterator */
+};
+
/* hash structure: */
/* This structure must match the beginning of struct xpvmg in sv.h. */
struct xpvhv {
@@ -40,10 +50,8 @@ struct xpvhv {
MAGIC* xmg_magic; /* magic for scalar array */
HV* xmg_stash; /* class package */
- I32 xhv_riter; /* current root of iterator */
- HE *xhv_eiter; /* current entry of iterator */
+ struct xpvhv_aux* xhv_aux;
/* list of pm's for this package is now stored in symtab magic. */
- char *xhv_name; /* name, if a symbol table */
};
/* hash a key */
@@ -178,9 +186,19 @@ C<SV*>.
#define HvARRAY(hv) (*(HE***)&((XPVHV*) SvANY(hv))->xhv_array)
#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 HvEITER(hv) ((XPVHV*) SvANY(hv))->xhv_eiter
-#define HvNAME(hv) ((XPVHV*) SvANY(hv))->xhv_name
+#define HvRITER(hv) (*Perl_hv_riter_p(aTHX_ (HV*)(hv)))
+#define HvEITER(hv) (*Perl_hv_eiter_p(aTHX_ (HV*)(hv)))
+#define HvRITER_set(hv,r) Perl_hv_riter_set(aTHX_ (HV*)(hv), r)
+#define HvEITER_set(hv,e) Perl_hv_eiter_set(aTHX_ (HV*)(hv), e)
+#define HvRITER_get(hv) (((XPVHV *)SvANY(hv))->xhv_aux ? \
+ ((struct xpvhv_aux*)((XPVHV *)SvANY(hv))->xhv_aux)->xhv_riter : -1)
+#define HvEITER_get(hv) (((XPVHV *)SvANY(hv))->xhv_aux ? \
+ ((struct xpvhv_aux *)((XPVHV *)SvANY(hv))->xhv_aux)->xhv_eiter : 0)
+#define HvNAME(hv) (*Perl_hv_name_p(aTHX_ (HV*)hv))
+/* 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_aux ? \
+ ((struct xpvhv_aux *)((XPVHV *)SvANY(hv))->xhv_aux)->xhv_name : 0)
/* the number of keys (including any placeholers) */
#define XHvTOTALKEYS(xhv) ((xhv)->xhv_keys)
@@ -318,3 +336,13 @@ C<SV*>.
/* 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:
+ */
diff --git a/mg.c b/mg.c
index 1611d1fb7d..f15dc268bf 100644
--- a/mg.c
+++ b/mg.c
@@ -1605,13 +1605,13 @@ Perl_magic_scalarpack(pTHX_ HV *hv, MAGIC *mg)
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;
}
diff --git a/op.c b/op.c
index 17522bf753..0e1e6b8707 100644
--- a/op.c
+++ b/op.c
@@ -1535,7 +1535,7 @@ S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs, bool for_my)
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;
@@ -1589,7 +1589,7 @@ S_apply_attrs_my(pTHX_ HV *stash, OP *target, OP *attrs, OP **imopsp)
/* 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);
@@ -4654,7 +4654,7 @@ Perl_newXS(pTHX_ const char *name, XSUBADDR_t subaddr, const char *filename)
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);
@@ -6805,7 +6805,7 @@ Perl_peep(pTHX_ register OP *o)
{
Perl_croak(aTHX_ "No such class field \"%s\" "
"in variable %s of type %s",
- key, SvPV_nolen(lexname), HvNAME(SvSTASH(lexname)));
+ key, SvPV_nolen(lexname), HvNAME_get(SvSTASH(lexname)));
}
break;
@@ -6862,7 +6862,7 @@ Perl_peep(pTHX_ register OP *o)
{
Perl_croak(aTHX_ "No such class field \"%s\" "
"in variable %s of type %s",
- key, SvPV_nolen(lexname), HvNAME(SvSTASH(lexname)));
+ key, SvPV_nolen(lexname), HvNAME_get(SvSTASH(lexname)));
}
}
break;
@@ -7134,7 +7134,7 @@ const_sv_xsub(pTHX_ CV* cv)
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);
diff --git a/op.h b/op.h
index 95cc1e6beb..f949179c72 100644
--- a/op.h
+++ b/op.h
@@ -330,13 +330,13 @@ struct pmop {
# 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)
diff --git a/perl.c b/perl.c
index c6e5ee3aa5..4ebcefa0e5 100644
--- a/perl.c
+++ b/perl.c
@@ -3061,7 +3061,7 @@ S_init_main_stash(pTHX)
SvREFCNT_dec(GvHV(gv));
GvHV(gv) = (HV*)SvREFCNT_inc(PL_defstash);
SvREADONLY_on(gv);
- HvNAME(PL_defstash) = savepvn("main", 4);
+ Perl_hv_name_set(aTHX_ 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 */
diff --git a/pp.c b/pp.c
index 19e740bd05..f4d1163a72 100644
--- a/pp.c
+++ b/pp.c
@@ -600,7 +600,7 @@ PP(pp_gelem)
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;
diff --git a/pp_hot.c b/pp_hot.c
index 93184cf1d3..1f9abc38e2 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1717,7 +1717,7 @@ PP(pp_helem)
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) {
@@ -3089,7 +3089,7 @@ S_method_common(pTHX_ SV* meth, U32* hashp)
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");
diff --git a/pp_sys.c b/pp_sys.c
index a75b87c23e..ab55aff162 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -798,7 +798,7 @@ PP(pp_tie)
switch(SvTYPE(varsv)) {
case SVt_PVHV:
methname = "TIEHASH";
- HvEITER((HV *)varsv) = Null(HE *);
+ HvEITER_set((HV *)varsv, 0);
break;
case SVt_PVAV:
methname = "TIEARRAY";
diff --git a/proto.h b/proto.h
index 8f8ab0ac13..3b07c32a9f 100644
--- a/proto.h
+++ b/proto.h
@@ -2311,7 +2311,12 @@ STATIC HE* S_hv_fetch_common(pTHX_ HV* tb, SV* key_sv, const char* key, STRLEN k
PERL_CALLCONV void Perl_hv_clear_placeholders(pTHX_ HV* hb);
PERL_CALLCONV SV* Perl_hv_scalar(pTHX_ HV* hv);
-
+PERL_CALLCONV I32* Perl_hv_riter_p(pTHX_ HV* hv);
+PERL_CALLCONV HE** Perl_hv_eiter_p(pTHX_ HV* hv);
+PERL_CALLCONV void Perl_hv_riter_set(pTHX_ HV* hv, I32 riter);
+PERL_CALLCONV void Perl_hv_eiter_set(pTHX_ HV* hv, HE* eiter);
+PERL_CALLCONV char** Perl_hv_name_p(pTHX_ HV* hv);
+PERL_CALLCONV void Perl_hv_name_set(pTHX_ HV* hv, const char *, STRLEN len, int flags);
PERL_CALLCONV I32* Perl_hv_placeholders_p(pTHX_ HV* hv);
PERL_CALLCONV I32 Perl_hv_placeholders_get(pTHX_ HV* hv);
PERL_CALLCONV void Perl_hv_placeholders_set(pTHX_ HV* hv, I32 ph);
diff --git a/sv.c b/sv.c
index 49e02f2ebf..51a389659d 100644
--- a/sv.c
+++ b/sv.c
@@ -754,7 +754,7 @@ S_varname(pTHX_ GV *gv, const char *gvtype, PADOFFSET targ,
sv_setpv(name, gvtype);
if (!hv)
p = "???";
- else if (!(p=HvNAME(hv)))
+ else if (!(p=HvNAME_get(hv)))
p = "__ANON__";
if (strNE(p, "main")) {
sv_catpv(name,p);
@@ -1970,9 +1970,7 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt)
break;
case SVt_PVHV:
SvANY(sv) = new_XPVHV();
- HvRITER(sv) = 0;
- HvEITER(sv) = 0;
- HvNAME(sv) = 0;
+ ((XPVHV*) SvANY(sv))->xhv_aux = 0;
HvFILL(sv) = 0;
HvMAX(sv) = 0;
HvTOTALKEYS(sv) = 0;
@@ -3659,7 +3657,7 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
}
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));
}
@@ -4451,7 +4449,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
CvCONST(cv)
? "Constant subroutine %s::%s redefined"
: "Subroutine %s::%s redefined",
- HvNAME(GvSTASH((GV*)dstr)),
+ HvNAME_get(GvSTASH((GV*)dstr)),
GvENAME((GV*)dstr));
}
}
@@ -5561,6 +5559,7 @@ Perl_sv_magic(pTHX_ register SV *sv, SV *obj, int how, const char *name, I32 nam
case PERL_MAGIC_vec:
vtable = &PL_vtbl_vec;
break;
+ case PERL_MAGIC_rhash:
case PERL_MAGIC_symtab:
case PERL_MAGIC_vstring:
vtable = 0;
@@ -5961,7 +5960,7 @@ Perl_sv_clear(pTHX_ register SV *sv)
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;
}
@@ -7983,7 +7982,7 @@ Perl_sv_reset(pTHX_ register const char *s, HV *stash)
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
@@ -8454,7 +8453,7 @@ Perl_sv_reftype(pTHX_ const SV *sv, int ob)
/* 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 {
@@ -8529,6 +8528,7 @@ an inheritance relationship.
int
Perl_sv_isa(pTHX_ SV *sv, const char *name)
{
+ const char *hvname;
if (!sv)
return 0;
if (SvGMAGICAL(sv))
@@ -8538,10 +8538,11 @@ Perl_sv_isa(pTHX_ SV *sv, const char *name)
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);
}
/*
@@ -10676,7 +10677,7 @@ S_gv_share(pTHX_ SV *sstr, CLONE_PARAMS *param)
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;
}
@@ -10782,11 +10783,12 @@ Perl_sv_dup(pTHX_ SV *sstr, CLONE_PARAMS* param)
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;
}
}
@@ -10914,7 +10916,7 @@ Perl_sv_dup(pTHX_ SV *sstr, CLONE_PARAMS* param)
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;
}
@@ -11020,30 +11022,43 @@ Perl_sv_dup(pTHX_ SV *sstr, CLONE_PARAMS* param)
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);
- if (HvARRAY((HV*)sstr)) {
- STRLEN i = 0;
- XPVHV *dxhv = (XPVHV*)SvANY(dstr);
- XPVHV *sxhv = (XPVHV*)SvANY(sstr);
- Newz(0, dxhv->xhv_array,
- PERL_HV_ARRAY_ALLOC_BYTES(dxhv->xhv_max+1), char);
- while (i <= sxhv->xhv_max) {
- ((HE**)dxhv->xhv_array)[i] = he_dup(((HE**)sxhv->xhv_array)[i],
- (bool)!!HvSHAREKEYS(sstr),
- param);
- ++i;
+ {
+ const char *hvname = HvNAME_get((HV*)sstr);
+ struct xpvhv_aux *aux = ((XPVHV *)SvANY(sstr))->xhv_aux;
+
+ if (aux) {
+ New(0, ((XPVHV *)SvANY(dstr))->xhv_aux, 1, struct xpvhv_aux);
+ HvRITER_set((HV*)dstr, HvRITER_get((HV*)sstr));
+ /* FIXME strlen HvNAME */
+ Perl_hv_name_set(aTHX_ (HV*) dstr, hvname,
+ hvname ? strlen(hvname) : 0,
+ 0);
+ } else {
+ ((XPVHV *)SvANY(dstr))->xhv_aux = 0;
}
- dxhv->xhv_eiter = he_dup(sxhv->xhv_eiter,
- (bool)!!HvSHAREKEYS(sstr), param);
- }
- else {
- SvPV_set(dstr, Nullch);
- HvEITER((HV*)dstr) = (HE*)NULL;
+ if (HvARRAY((HV*)sstr)) {
+ STRLEN i = 0;
+ XPVHV *dxhv = (XPVHV*)SvANY(dstr);
+ XPVHV *sxhv = (XPVHV*)SvANY(sstr);
+ Newz(0, dxhv->xhv_array,
+ PERL_HV_ARRAY_ALLOC_BYTES(dxhv->xhv_max+1), char);
+ while (i <= sxhv->xhv_max) {
+ ((HE**)dxhv->xhv_array)[i]
+ = he_dup(((HE**)sxhv->xhv_array)[i],
+ (bool)!!HvSHAREKEYS(sstr), param);
+ ++i;
+ }
+ HvEITER_set(dstr, he_dup(HvEITER_get(sstr),
+ (bool)!!HvSHAREKEYS(sstr), param));
+ }
+ else {
+ SvPV_set(dstr, Nullch);
+ HvEITER_set((HV*)dstr, (HE*)NULL);
+ }
+ /* Record stashes for possible cloning in Perl_clone(). */
+ if(hvname)
+ av_push(param->stashes, dstr);
}
- HvNAME((HV*)dstr) = SAVEPV(HvNAME((HV*)sstr));
- /* Record stashes for possible cloning in Perl_clone(). */
- if(HvNAME((HV*)dstr))
- av_push(param->stashes, dstr);
break;
case SVt_PVFM:
SvANY(dstr) = new_XPVFM();
@@ -11547,7 +11562,8 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
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)) {
@@ -11557,7 +11573,7 @@ do_mark_cloneable_stash(pTHX_ SV *sv)
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;
@@ -12406,7 +12422,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
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;
diff --git a/toke.c b/toke.c
index b570040d48..d496f48c35 100644
--- a/toke.c
+++ b/toke.c
@@ -4346,7 +4346,7 @@ Perl_yylex(pTHX)
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);
@@ -4358,7 +4358,7 @@ Perl_yylex(pTHX)
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))
@@ -5536,7 +5536,7 @@ S_pending_ident(pTHX)
/* 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);
@@ -9737,7 +9737,7 @@ S_scan_inputsymbol(pTHX_ char *start)
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);
diff --git a/universal.c b/universal.c
index b62e368573..e02bf00577 100644
--- a/universal.c
+++ b/universal.c
@@ -40,13 +40,16 @@ S_isa_lookup(pTHX_ HV *stash, const char *name, HV* name_stash,
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"))
@@ -54,7 +57,7 @@ S_isa_lookup(pTHX_ HV *stash, const char *name, HV* name_stash,
if (level > 100)
Perl_croak(aTHX_ "Recursive inheritance detected in package '%s'",
- HvNAME(stash));
+ hvname);
gvp = (GV**)hv_fetch(stash, "::ISA::CACHE::", 14, FALSE);
@@ -66,13 +69,13 @@ S_isa_lookup(pTHX_ HV *stash, const char *name, HV* name_stash,
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);
}
@@ -106,8 +109,8 @@ S_isa_lookup(pTHX_ HV *stash, const char *name, HV* name_stash,
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,
@@ -348,11 +351,12 @@ XS(XS_UNIVERSAL_VERSION)
SV *req = ST(1);
if (undef) {
- if (pkg)
+ 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 {
+ "%s does not define $%s::VERSION--version check failed",
+ name, name);
+ } else {
STRLEN n_a;
Perl_croak(aTHX_
"%s defines neither package nor VERSION--version check failed",
@@ -370,7 +374,7 @@ XS(XS_UNIVERSAL_VERSION)
if ( vcmp( req, sv ) > 0 )
Perl_croak(aTHX_ "%s version %"SVf" (%"SVf") required--"
- "this is only version %"SVf" (%"SVf")", HvNAME(pkg),
+ "this is only version %"SVf" (%"SVf")", HvNAME_get(pkg),
vnumify(req),vnormal(req),vnumify(sv),vnormal(sv));
}
diff --git a/xsutils.c b/xsutils.c
index 5956ff2762..7cdf41a63f 100644
--- a/xsutils.c
+++ b/xsutils.c
@@ -258,7 +258,7 @@ usage:
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 */
@@ -284,7 +284,7 @@ usage:
break;
}
if (stash)
- sv_setpv(TARG, HvNAME(stash));
+ sv_setpv(TARG, HvNAME_get(stash));
}
SvSETMAGIC(TARG);
View Lorry Controller Status