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;
case SVt_PVIO:
Perl_croak(aTHX_ "Cannot convert a reference to %s to typeglob",
sv_reftype(has_constant, 0));
+ default: NOOP;
}
SvRV_set(gv, NULL);
SvROK_off(gv);
} 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);
GV** gvp;
CV* cv;
const char *hvname;
+ HV* lastchance = NULL;
/* UNIVERSAL methods should be callable without a stash */
if (!stash) {
/* if at top level, try UNIVERSAL */
if (level == 0 || level == -1) {
- HV* const lastchance = gv_stashpvs("UNIVERSAL", FALSE);
+ lastchance = gv_stashpvs("UNIVERSAL", FALSE);
if (lastchance) {
if ((gv = gv_fetchmeth(lastchance, name, len,
sv_setpvn(varsv, packname, packname_len);
sv_catpvs(varsv, "::");
sv_catpvn(varsv, name, len);
- SvTAINTED_off(varsv);
return gv;
}
: sv_type == SVt_PVAV ? "@"
: sv_type == SVt_PVHV ? "%"
: ""), name);
+ GV *gv;
if (USE_UTF8_IN_NAMES)
SvUTF8_on(err);
qerror(err);
- stash = GvHV(gv_fetchpvn_flags("<none>::", 8, GV_ADDMULTI, SVt_PVHV));
+ gv = gv_fetchpvn_flags("<none>::", 8, GV_ADDMULTI, SVt_PVHV);
+ if(!gv) {
+ /* symbol table under destruction */
+ return NULL;
+ }
+ stash = GvHV(gv);
}
else
return NULL;
if (strEQ(name2, "RGV")) {
IoFLAGS(GvIOn(gv)) |= IOf_ARGV|IOf_START;
}
+ else if (strEQ(name2, "RGVOUT")) {
+ GvMULTI_on(gv);
+ }
break;
case 'E':
if (strnEQ(name2, "XPORT", 5))
}
void
-Perl_gv_check(pTHX_ HV *stash)
+Perl_gv_check(pTHX_ const HV *stash)
{
dVAR;
register I32 i;
return;
}
+ unshare_hek(gp->gp_file_hek);
SvREFCNT_dec(gp->gp_sv);
SvREFCNT_dec(gp->gp_av);
/* FIXME - another reference loop GV -> symtab -> GV ?
{
dVAR;
MAGIC* const mg = mg_find((SV*)stash, PERL_MAGIC_overload_table);
- AMT * const amtp = (mg) ? (AMT*)mg->mg_ptr: (AMT *) NULL;
AMT amt;
- if (mg && amtp->was_ok_am == PL_amagic_generation
- && amtp->was_ok_sub == PL_sub_generation)
- return (bool)AMT_OVERLOADED(amtp);
- sv_unmagic((SV*)stash, PERL_MAGIC_overload_table);
+ if (mg) {
+ const AMT * const amtp = (AMT*)mg->mg_ptr;
+ if (amtp->was_ok_am == PL_amagic_generation
+ && amtp->was_ok_sub == PL_sub_generation) {
+ 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_get(stash)) );
Gv_AMupdate(stash);
mg = mg_find((SV*)stash, PERL_MAGIC_overload_table);
}
+ assert(mg);
amtp = (AMT*)mg->mg_ptr;
if ( amtp->was_ok_am != PL_amagic_generation
|| amtp->was_ok_sub != PL_sub_generation )