}
}
+/* Assign CvSTASH(cv) = st, handling weak references. */
+
+void
+Perl_cvstash_set(pTHX_ CV *cv, HV *st)
+{
+ HV *oldst = CvSTASH(cv);
+ PERL_ARGS_ASSERT_CVSTASH_SET;
+ if (oldst == st)
+ return;
+ if (oldst)
+ sv_del_backref(MUTABLE_SV(oldst), MUTABLE_SV(cv));
+ SvANY(cv)->xcv_stash = st;
+ if (st)
+ Perl_sv_add_backref(aTHX_ MUTABLE_SV(st), MUTABLE_SV(cv));
+}
void
Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi)
mro_method_changed_in(GvSTASH(gv)); /* sub Foo::bar($) { (shift) } sub ASDF::baz($); *ASDF::baz = \&Foo::bar */
CvGV_set(cv, gv);
CvFILE_set_from_cop(cv, PL_curcop);
- CvSTASH(cv) = PL_curstash;
- if (PL_curstash)
- Perl_sv_add_backref(aTHX_ MUTABLE_SV(PL_curstash), MUTABLE_SV(cv));
+ CvSTASH_set(cv, PL_curstash);
if (proto) {
sv_usepvn_flags(MUTABLE_SV(cv), proto, protolen,
SV_HAS_TRAILING_NUL);
* and split that value on the last '::',
* pass along the same data via some unused fields in the CV
*/
- CvSTASH(cv) = stash;
- if (stash)
- Perl_sv_add_backref(aTHX_ MUTABLE_SV(stash), MUTABLE_SV(cv));
+ CvSTASH_set(cv, stash);
SvPV_set(cv, (char *)name); /* cast to lose constness warning */
SvCUR_set(cv, len);
return gv;
Safefree(tmpbuf);
if (!tmpgv)
return NULL;
- if (!GvHV(tmpgv))
- GvHV(tmpgv) = newHV();
stash = GvHV(tmpgv);
- if (!HvNAME_get(stash))
- hv_name_set(stash, name, namelen, 0);
+ assert(stash);
+ assert(HvNAME_get(stash));
return stash;
}
}
STATIC void
-S_gv_magicalize_isa(pTHX_ GV *gv, const char *nambeg, I32 add)
+S_gv_magicalize_isa(pTHX_ GV *gv)
{
AV* av;
GvMULTI_on(gv);
sv_magic(MUTABLE_SV(av), MUTABLE_SV(gv), PERL_MAGIC_isa,
NULL, 0);
- /* NOTE: No support for tied ISA */
- if ((add & GV_ADDMULTI) && strEQ(nambeg,"AnyDBM_File::ISA")
- && AvFILLp(av) == -1)
- {
- av_push(av, newSVpvs("NDBM_File"));
- gv_stashpvs("NDBM_File", GV_ADD);
- av_push(av, newSVpvs("DB_File"));
- gv_stashpvs("DB_File", GV_ADD);
- av_push(av, newSVpvs("GDBM_File"));
- gv_stashpvs("GDBM_File", GV_ADD);
- av_push(av, newSVpvs("SDBM_File"));
- gv_stashpvs("SDBM_File", GV_ADD);
- av_push(av, newSVpvs("ODBM_File"));
- gv_stashpvs("ODBM_File", GV_ADD);
- }
}
STATIC void
len = name_cursor - name;
if (len > 0) {
- char *tmpbuf;
-
- if (name_cursor == ':') {
- tmpbuf = name;
+ const char *key;
+ if (*name_cursor == ':') {
+ key = name;
len += 2;
} else {
+ char *tmpbuf;
Newx(tmpbuf, len+2, char);
Copy(name, tmpbuf, len, char);
tmpbuf[len++] = ':';
tmpbuf[len++] = ':';
+ key = tmpbuf;
}
- gvp = (GV**)hv_fetch(stash,tmpbuf,len,add);
+ gvp = (GV**)hv_fetch(stash, key, len, add);
gv = gvp ? *gvp : NULL;
if (gv && gv != (const GV *)&PL_sv_undef) {
if (SvTYPE(gv) != SVt_PVGV)
- gv_init(gv, stash, tmpbuf, len, (add & GV_ADDMULTI));
+ gv_init(gv, stash, key, len, (add & GV_ADDMULTI));
else
GvMULTI_on(gv);
}
- if (tmpbuf != name)
- Safefree(tmpbuf);
+ if (key != name)
+ Safefree((char *)key);
if (!gv || gv == (const GV *)&PL_sv_undef)
return NULL;
break;
case 'I':
if (strEQ(name2, "SA"))
- gv_magicalize_isa(gv, nambeg, add);
+ gv_magicalize_isa(gv);
break;
case 'O':
if (strEQ(name2, "VERLOAD"))
break;
case 'I':
if (strEQ(name2, "SA")) {
- gv_magicalize_isa(gv, nambeg, add);
+ gv_magicalize_isa(gv);
}
break;
case 'O':
PERL_ARGS_ASSERT_AMAGIC_CALL;
if ( PL_curcop->cop_hints & HINT_NO_AMAGIC ) {
- SV *lex_mask = Perl_refcounted_he_fetch(aTHX_ PL_curcop->cop_hints_hash,
- 0, "overloading", 11, 0, 0);
+ SV *lex_mask = cop_hints_fetch_pvs(PL_curcop, "overloading", 0);
if ( !lex_mask || !SvOK(lex_mask) )
/* overloading lexically disabled */