return SvROK(gv) ? SvRV(gv) : NULL;
}
+GP *
+Perl_newGP(pTHX_ GV *const gv)
+{
+ GP *gp;
+ const char *const file = CopFILE(PL_curcop) ? CopFILE(PL_curcop) : "";
+ STRLEN len = strlen(file);
+ U32 hash;
+
+ PERL_HASH(hash, file, len);
+
+ Newxz(gp, 1, GP);
+
+#ifndef PERL_DONT_CREATE_GVSV
+ gp->gv_sv = newSV(0);
+#endif
+
+ gp->gp_line = CopLINE(PL_curcop);
+ /* XXX Ideally this cast would be replaced with a change to const char*
+ in the struct. */
+ gp->gp_file_hek = share_hek(file, len, hash);
+ gp->gp_egv = gv;
+ gp->gp_refcnt = 1;
+
+ return gp;
+}
+
void
Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi)
{
dVAR;
- register GP *gp;
const U32 old_type = SvTYPE(gv);
const bool doproto = old_type > SVt_NULL;
const char * const proto = (doproto && SvPOK(gv)) ? SvPVX_const(gv) : NULL;
} else
Safefree(SvPVX_mutable(gv));
}
- Newxz(gp, 1, GP);
SvSCREAM_on(gv);
- GvGP(gv) = gp_ref(gp);
-#ifdef PERL_DONT_CREATE_GVSV
- GvSV(gv) = NULL;
-#else
- GvSV(gv) = newSV(0);
-#endif
- GvLINE(gv) = CopLINE(PL_curcop);
- /* XXX Ideally this cast would be replaced with a change to const char*
- in the struct. */
- GvFILE(gv) = CopFILE(PL_curcop) ? CopFILE(PL_curcop) : (char *) "";
- GvCVGEN(gv) = 0;
- GvEGV(gv) = gv;
+
+ GvGP(gv) = Perl_newGP(aTHX_ gv);
GvSTASH(gv) = stash;
if (stash)
Perl_sv_add_backref(aTHX_ (SV*)stash, (SV*)gv);
if (!basestash) {
if (ckWARN(WARN_MISC))
Perl_warner(aTHX_ packWARN(WARN_MISC), "Can't locate package %"SVf" for @%s::ISA",
- sv, hvname);
+ (void*)sv, hvname);
continue;
}
gv = gv_fetchmeth(basestash, name, len,
GV* vargv;
SV* varsv;
const char *packname = "";
- STRLEN packname_len;
+ STRLEN packname_len = 0;
if (len == S_autolen && strnEQ(name, S_autoload, S_autolen))
return NULL;
char smallbuf[128];
char *tmpbuf;
- if (len + 3 < sizeof (smallbuf))
+ if (len + 3 < (I32)sizeof (smallbuf))
tmpbuf = smallbuf;
else
Newx(tmpbuf, len+3, char);
if (len > 1) {
#ifndef EBCDIC
if (*name > 'V' ) {
- /*EMPTY*/;
+ NOOP;
/* Nothing else to do.
The compiler will probably turn the switch statement into a
branch table. Make sure we avoid even that small overhead for
sv_setiv(GvSVn(gv), (IV)(IoFLAGS(GvIOp(PL_defoutgv)) & IOf_FLUSH) != 0);
goto magicalize;
+ case '\010': /* $^H */
+ {
+ HV *const hv = GvHVn(gv);
+ hv_magic(hv, NULL, PERL_MAGIC_hints);
+ }
+ goto magicalize;
+
case '+':
{
AV* const av = GvAVn(gv);
case '\004': /* $^D */
case '\005': /* $^E */
case '\006': /* $^F */
- case '\010': /* $^H */
case '\011': /* $^I, NOT \t in EBCDIC */
case '\016': /* $^N */
case '\017': /* $^O */
return;
}
- if (gp->gp_sv) SvREFCNT_dec(gp->gp_sv);
- if (gp->gp_av) SvREFCNT_dec(gp->gp_av);
+ unshare_hek(gp->gp_file_hek);
+ SvREFCNT_dec(gp->gp_sv);
+ SvREFCNT_dec(gp->gp_av);
/* 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) {
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);
- if (gp->gp_form) SvREFCNT_dec(gp->gp_form);
+ SvREFCNT_dec(gp->gp_io);
+ SvREFCNT_dec(gp->gp_cv);
+ SvREFCNT_dec(gp->gp_form);
Safefree(gp);
GvGP(gv) = 0;
lim = DESTROY_amg; /* Skip overloading entries. */
#ifdef PERL_DONT_CREATE_GVSV
else if (!sv) {
- /*EMPTY*/; /* Equivalent to !SvTRUE and !SvOK */
+ NOOP; /* Equivalent to !SvTRUE and !SvOK */
}
#endif
else if (SvTRUE(sv))
DEBUG_o( Perl_deb(aTHX_ "Resolving method \"%"SVf256\
"\" for overloaded \"%s\" in package \"%.256s\"\n",
- GvSV(gv), cp, hvname) );
+ (void*)GvSV(gv), cp, hvname) );
if (!gvsv || !SvPOK(gvsv)
|| !(ngv = gv_fetchmethod_autoload(stash, SvPVX_const(gvsv),
FALSE)))
if (amtp && amtp->fallback >= AMGfallYES) {
DEBUG_o( Perl_deb(aTHX_ "%s", SvPVX_const(msg)) );
} else {
- Perl_croak(aTHX_ "%"SVf, msg);
+ Perl_croak(aTHX_ "%"SVf, (void*)msg);
}
return NULL;
}
dVAR;
U32 hash;
+ assert(name);
PERL_UNUSED_ARG(flags);
if (len > I32_MAX)
}
PERL_HASH(hash, name, len);
- GvNAME_HEK(gv) = name ? share_hek(name, len, hash) : 0;
+ GvNAME_HEK(gv) = share_hek(name, len, hash);
}
/*