Perl_cvgv_set(pTHX_ CV* cv, GV* gv)
{
GV * const oldgv = CvGV(cv);
+ HEK *hek;
PERL_ARGS_ASSERT_CVGV_SET;
if (oldgv == gv)
sv_del_backref(MUTABLE_SV(oldgv), MUTABLE_SV(cv));
}
}
+ else if ((hek = CvNAME_HEK(cv))) unshare_hek(hek);
- SvANY(cv)->xcv_gv = gv;
+ SvANY(cv)->xcv_gv_u.xcv_gv = gv;
assert(!CvCVGV_RC(cv));
if (!gv)
}
packlen = HvNAMELEN_get(stash);
- if (packlen >= 7 && strEQ(hvname + packlen - 7, "::SUPER")) {
+ if ((packlen >= 7 && strEQ(hvname + packlen - 7, "::SUPER"))
+ || (packlen == 5 && strEQ(hvname, "SUPER"))) {
HV* basestash;
- packlen -= 7;
- basestash = gv_stashpvn(hvname, packlen,
+ basestash = packlen == 5
+ ? PL_defstash
+ : gv_stashpvn(hvname, packlen - 7,
GV_ADD | (HvNAMEUTF8(stash) ? SVf_UTF8 : 0));
linear_av = mro_get_linear_isa(basestash);
}
GvMULTI_on(gv);
sv_magic(MUTABLE_SV(superisa), MUTABLE_SV(gv), PERL_MAGIC_isa, NULL, 0);
av_push(superisa, newSVhek(CopSTASH(PL_curcop)
- ? HvNAME_HEK(CopSTASH(PL_curcop)) : NULL));
+ ? HvENAME_HEK(CopSTASH(PL_curcop)) : NULL));
return stash;
}
Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN len, U32 flags)
{
dVAR;
- register const char *nend;
+ const char *nend;
const char *nsplit = NULL;
GV* gv;
HV* ostash = stash;
/* ->SUPER::method should really be looked up in original stash */
SV * const tmpstr = sv_2mortal(Perl_newSVpvf(aTHX_
"%"HEKf"::SUPER",
- HEKfARG(HvNAME_HEK((HV*)CopSTASH(PL_curcop)))
+ HEKfARG(HvENAME_HEK((HV*)CopSTASH(PL_curcop)))
));
/* __PACKAGE__::SUPER stash should be autovivified */
stash = gv_get_super_pkg(SvPVX_const(tmpstr), SvCUR(tmpstr), SvUTF8(tmpstr));
DEBUG_o( Perl_deb(aTHX_ "Treating %s as %s::%s\n",
- origname, HvNAME_get(stash), name) );
+ origname, HvENAME_get(stash), name) );
}
else {
/* don't autovifify if ->NoSuchStash::method */
}
LEAVE;
varsv = GvSVn(vargv);
+ SvTAINTED_off(varsv); /* previous $AUTOLOAD taint is obsolete */
+ /* XXX: this process is not careful to avoid extra magic gets and sets; tied $AUTOLOAD will get noise */
sv_setsv(varsv, packname);
sv_catpvs(varsv, "::");
/* Ensure SvSETMAGIC() is called if necessary. In particular, to clear
C<flags> is 0 (or any other setting that does not create packages) then NULL
is returned.
+Flags may be one of:
+
+ GV_ADD
+ SVf_UTF8
+ GV_NOADD_NOINIT
+ GV_NOINIT
+ GV_NOEXPAND
+ GV_ADDMG
+
+The most important of which are probably GV_ADD and SVf_UTF8.
=cut
*/
const svtype sv_type)
{
dVAR;
- register const char *name = nambeg;
- register GV *gv = NULL;
+ const char *name = nambeg;
+ GV *gv = NULL;
GV**gvp;
I32 len;
- register const char *name_cursor;
+ const char *name_cursor;
HV *stash = NULL;
const I32 no_init = flags & (GV_NOADD_NOINIT | GV_NOINIT);
const I32 no_expand = flags & GV_NOEXPAND;
require_tie_mod(gv, name, newSVpvs("Tie::Hash::NamedCapture"), "TIEHASH", 0);
}
if (sv_type==SVt_PV || sv_type==SVt_PVGV) {
- if (*name == '[')
- require_tie_mod(gv,name,newSVpvs("arybase"),"FETCH",0);
- else if (*name == '&' || *name == '`' || *name == '\'') {
- PL_sawampersand = TRUE;
- (void)GvSVn(gv);
- }
+ switch (*name) {
+ case '[':
+ require_tie_mod(gv,name,newSVpvs("arybase"),"FETCH",0);
+ break;
+ case '`':
+ PL_sawampersand |= SAWAMPERSAND_LEFT;
+ (void)GvSVn(gv);
+ break;
+ case '&':
+ PL_sawampersand |= SAWAMPERSAND_MIDDLE;
+ (void)GvSVn(gv);
+ break;
+ case '\'':
+ PL_sawampersand |= SAWAMPERSAND_RIGHT;
+ (void)GvSVn(gv);
+ break;
+ }
}
}
else if (len == 3 && sv_type == SVt_PVAV
sv_type == SVt_PVCV ||
sv_type == SVt_PVFM ||
sv_type == SVt_PVIO
- )) { PL_sawampersand = TRUE; }
+ )) { PL_sawampersand |=
+ (*name == '`')
+ ? SAWAMPERSAND_LEFT
+ : (*name == '&')
+ ? SAWAMPERSAND_MIDDLE
+ : SAWAMPERSAND_RIGHT;
+ }
goto magicalize;
case ':': /* $: */
Perl_gv_check(pTHX_ const HV *stash)
{
dVAR;
- register I32 i;
+ I32 i;
PERL_ARGS_ASSERT_GV_CHECK;
for (i = 0; i <= (I32) HvMAX(stash); i++) {
const HE *entry;
for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) {
- register GV *gv;
+ GV *gv;
HV *hv;
if (HeKEY(entry)[HeKLEN(entry)-1] == ':' &&
(gv = MUTABLE_GV(HeVAL(entry))) && isGV(gv) && (hv = GvHV(gv)))