/* create and re-create @.*::SUPER::ISA on demand */
if (!av || !SvMAGIC(av)) {
- /* FIXME - get this from the symtab magic. */
- STRLEN packlen = strlen(hvname);
+ STRLEN packlen = HvNAMELEN_get(stash);
if (packlen >= 7 && strEQ(hvname + packlen - 7, "::SUPER")) {
HV* basestash;
GV* vargv;
SV* varsv;
const char *packname = "";
+ STRLEN packname_len;
if (len == S_autolen && strnEQ(name, S_autoload, S_autolen))
return Nullgv;
if (stash) {
if (SvTYPE(stash) < SVt_PVHV) {
- packname = SvPV_nolen((SV*)stash);
+ packname = SvPV_const((SV*)stash, packname_len);
stash = Nullhv;
}
else {
packname = HvNAME_get(stash);
+ packname_len = HvNAMELEN_get(stash);
}
}
if (!(gv = gv_fetchmeth(stash, S_autoload, S_autolen, FALSE)))
gv_init(vargv, varstash, S_autoload, S_autolen, FALSE);
LEAVE;
varsv = GvSV(vargv);
- sv_setpv(varsv, packname);
+ sv_setpvn(varsv, packname, packname_len);
sv_catpvn(varsv, "::", 2);
sv_catpvn(varsv, name, len);
SvTAINTED_off(varsv);
dVAR;
HV* stash = gv_stashpvn("Errno",5,FALSE);
- if (!stash || !(gv_fetchmethod(stash, "TIEHASH"))) {
+ if (!stash || !(gv_fetchmethod(stash, "TIEHASH"))) {
dSP;
PUTBACK;
ENTER;
Perl_gv_stashsv(pTHX_ SV *sv, I32 create)
{
STRLEN len;
- const char *ptr = SvPV(sv,len);
+ const char *ptr = SvPV_const(sv,len);
return gv_stashpvn(ptr, len, create);
}
GV *
Perl_gv_fetchsv(pTHX_ SV *name, I32 flags, I32 sv_type) {
STRLEN len;
- const char *nambeg = SvPV(name, len);
+ const char *nambeg = SvPV_const(name, len);
return gv_fetchpvn_flags(nambeg, len, flags | SvUTF8(name), sv_type);
}
stash = GvHV(gv) = newHV();
if (!HvNAME_get(stash))
- Perl_hv_name_set(aTHX, stash, nambeg, namend - nambeg, 0);
+ Perl_hv_name_set(aTHX_ stash, nambeg, namend - nambeg, 0);
}
if (*namend == ':')
gv_init(gv, stash, name, len, add & GV_ADDMULTI);
gv_init_sv(gv, sv_type);
- if (isALPHA(name[0]) && ! (isLEXWARN_on ? ckWARN(WARN_ONCE)
+ if (isALPHA(name[0]) && ! (isLEXWARN_on ? ckWARN(WARN_ONCE)
: (PL_dowarn & G_WARN_ON ) ) )
GvMULTI_on(gv) ;
} else
#endif
{
- const char *name2 = name + 1;
+ const char * const name2 = name + 1;
switch (*name) {
case 'A':
if (strEQ(name2, "RGV")) {
goto ro_magicalize;
break;
case '\025': /* ${^UNICODE}, ${^UTF8LOCALE} */
- if (strEQ(name2, "NICODE"))
+ if (strEQ(name2, "NICODE"))
goto ro_magicalize;
- if (strEQ(name2, "TF8LOCALE"))
+ if (strEQ(name2, "TF8LOCALE"))
goto ro_magicalize;
break;
case '\027': /* $^WARNING_BITS */
case '?':
#ifdef COMPLEX_STATUS
- (void)SvUPGRADE(GvSV(gv), SVt_PVLV);
+ SvUPGRADE(GvSV(gv), SVt_PVLV);
#endif
goto magicalize;
goto magicalize;
}
case '*':
- if (sv_type == SVt_PV && ckWARN2(WARN_DEPRECATED, WARN_SYNTAX))
- Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
- "$* is no longer supported");
- break;
case '#':
if (sv_type == SVt_PV && ckWARN2(WARN_DEPRECATED, WARN_SYNTAX))
Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
- "Use of $# is deprecated");
- goto magicalize;
+ "$%c is no longer supported", *name);
+ break;
case '|':
sv_setiv(GvSV(gv), (IV)(IoFLAGS(GvIOp(PL_defoutgv)) & IOf_FLUSH) != 0);
goto magicalize;
break;
case '\014': /* $^L */
- sv_setpv(GvSV(gv),"\f");
+ sv_setpvn(GvSV(gv),"\f",1);
PL_formfeed = GvSV(gv);
break;
case ';':
- sv_setpv(GvSV(gv),"\034");
+ sv_setpvn(GvSV(gv),"\034",1);
break;
case ']':
{
Perl_gv_fullname4(pTHX_ SV *sv, const GV *gv, const char *prefix, bool keepmain)
{
const char *name;
+ STRLEN namelen;
const HV * const hv = GvSTASH(gv);
if (!hv) {
SvOK_off(sv);
return;
}
sv_setpv(sv, prefix ? prefix : "");
-
+
name = HvNAME_get(hv);
- if (!name)
+ if (name) {
+ namelen = HvNAMELEN_get(hv);
+ } else {
name = "__ANON__";
-
+ namelen = 8;
+ }
+
if (keepmain || strNE(name, "main")) {
- sv_catpv(sv,name);
+ sv_catpvn(sv,name,namelen);
sv_catpvn(sv,"::", 2);
}
sv_catpvn(sv,GvNAME(gv),GvNAMELEN(gv));
sv_upgrade((SV *)io,SVt_PVIO);
SvREFCNT(io) = 1;
SvOBJECT_on(io);
- /* Clear the stashcache because a new IO could overrule a
- package name */
+ /* Clear the stashcache because a new IO could overrule a package name */
hv_clear(PL_stashcache);
iogv = gv_fetchpv("FileHandle::", FALSE, SVt_PVHV);
/* unless exists($main::{FileHandle}) and defined(%main::FileHandle::) */
/* 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);
+ hv_delete(PL_stashcache, hvname, HvNAMELEN_get(gp->gp_hv),
+ G_DISCARD);
SvREFCNT_dec(gp->gp_hv);
}
if (gp->gp_io) SvREFCNT_dec(gp->gp_io);
int
Perl_magic_freeovrld(pTHX_ SV *sv, MAGIC *mg)
{
- AMT *amtp = (AMT*)mg->mg_ptr;
- (void)sv;
+ AMT * const amtp = (AMT*)mg->mg_ptr;
+ PERL_UNUSED_ARG(sv);
if (amtp && AMT_AMAGIC(amtp)) {
int i;
for (i = 1; i < NofAMmeth; i++) {
- CV *cv = amtp->table[i];
+ CV * const cv = amtp->table[i];
if (cv != Nullcv) {
SvREFCNT_dec((SV *) cv);
amtp->table[i] = Nullcv;
bool
Perl_Gv_AMupdate(pTHX_ HV *stash)
{
- GV* gv;
- CV* cv;
- MAGIC* mg=mg_find((SV*)stash, PERL_MAGIC_overload_table);
- AMT *amtp = (mg) ? (AMT*)mg->mg_ptr: (AMT *) NULL;
+ 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
{
int filled = 0, have_ovl = 0;
int i, lim = 1;
- SV* sv = NULL;
/* Work with "fallback" key, which we assume to be first in PL_AMG_names */
/* Try to find via inheritance. */
- gv = gv_fetchmeth(stash, PL_AMG_names[0], 2, -1);
- if (gv)
- sv = GvSV(gv);
+ GV *gv = gv_fetchmeth(stash, PL_AMG_names[0], 2, -1);
+ SV * const sv = gv ? GvSV(gv) : NULL;
+ CV* cv;
if (!gv)
lim = DESTROY_amg; /* Skip overloading entries. */
const char *cp = (i >= DESTROY_amg ? cooky : AMG_id2name(i));
const STRLEN l = strlen(cooky);
- DEBUG_o( Perl_deb(aTHX_ "Checking overloading of `%s' in package `%.256s'\n",
+ DEBUG_o( Perl_deb(aTHX_ "Checking overloading of \"%s\" in package \"%.256s\"\n",
cp, HvNAME_get(stash)) );
/* don't fill the cache while looking up!
Creation of inheritance stubs in intermediate packages may
knowing *which* methods were declared as overloaded. */
/* GvSV contains the name of the method. */
GV *ngv = Nullgv;
-
- DEBUG_o( Perl_deb(aTHX_ "Resolving method `%"SVf256\
- "' for overloaded `%s' in package `%.256s'\n",
+
+ DEBUG_o( Perl_deb(aTHX_ "Resolving method \"%"SVf256\
+ "\" for overloaded \"%s\" in package \"%.256s\"\n",
GvSV(gv), cp, hvname) );
if (!SvPOK(GvSV(gv))
|| !(ngv = gv_fetchmethod_autoload(stash, SvPVX_const(GvSV(gv)),
FALSE)))
{
- /* Can be an import stub (created by `can'). */
+ /* Can be an import stub (created by "can"). */
SV *gvsv = GvSV(gv);
- const char *name = SvPOK(gvsv) ? SvPVX_const(gvsv) : "???";
- Perl_croak(aTHX_ "%s method `%.256s' overloading `%s' "\
- "in package `%.256s'",
+ const char * const name = SvPOK(gvsv) ? SvPVX_const(gvsv) : "???";
+ Perl_croak(aTHX_ "%s method \"%.256s\" overloading \"%s\" "\
+ "in package \"%.256s\"",
(GvCVGEN(gv) ? "Stub found while resolving"
: "Can't resolve"),
name, cp, hvname);
}
cv = GvCV(gv = ngv);
}
- DEBUG_o( Perl_deb(aTHX_ "Overloading `%s' in package `%.256s' via `%.256s::%.256s' \n",
+ DEBUG_o( Perl_deb(aTHX_ "Overloading \"%s\" in package \"%.256s\" via \"%.256s::%.256s\"\n",
cp, HvNAME_get(stash), HvNAME_get(GvSTASH(CvGV(cv))),
GvNAME(CvGV(cv))) );
filled = 1;
}
return ret;
}
-
+
return Nullcv;
}
CV *cv=NULL;
CV **cvp=NULL, **ocvp=NULL;
AMT *amtp=NULL, *oamtp=NULL;
- int off=0, off1, lr=0, assign=AMGf_assign & flags, notfound=0;
- int postpr = 0, force_cpy = 0, assignshift = assign ? 1 : 0;
+ int off = 0, off1, lr = 0, notfound = 0;
+ int postpr = 0, force_cpy = 0;
+ int assign = AMGf_assign & flags;
+ const int assignshift = assign ? 1 : 0;
#ifdef DEBUGGING
int fl=0;
#endif
(
#ifdef DEBUGGING
fl = 1,
-#endif
+#endif
cv = cvp[off=method])))) {
lr = -1; /* Call method for left argument */
} else {
SV *msg;
if (off==-1) off=method;
msg = sv_2mortal(Perl_newSVpvf(aTHX_
- "Operation `%s': no method found,%sargument %s%s%s%s",
+ "Operation \"%s\": no method found,%sargument %s%s%s%s",
AMG_id2name(method + assignshift),
(flags & AMGf_unary ? " " : "\n\tleft "),
SvAMAGIC(left)?
#ifdef DEBUGGING
if (!notfound) {
DEBUG_o(Perl_deb(aTHX_
- "Overloaded operator `%s'%s%s%s:\n\tmethod%s found%s in package %s%s\n",
+ "Overloaded operator \"%s\"%s%s%s:\n\tmethod%s found%s in package %s%s\n",
AMG_id2name(off),
method+assignshift==off? "" :
- " (initially `",
+ " (initially \"",
method+assignshift==off? "" :
AMG_id2name(method+assignshift),
- method+assignshift==off? "" : "')",
+ method+assignshift==off? "" : "\")",
flags & AMGf_unary? "" :
lr==1 ? " for right argument": " for left argument",
flags & AMGf_unary? " for argument" : "",
Perl_is_gv_magical_sv(pTHX_ SV *name, U32 flags)
{
STRLEN len;
- const char *temp = SvPV(name, len);
+ const char *temp = SvPV_const(name, len);
return is_gv_magical(temp, len, flags);
}
{
(void)flags;
if (len > 1) {
- const char *name1 = name + 1;
+ const char * const name1 = name + 1;
switch (*name) {
case 'I':
if (len == 3 && name1[1] == 'S' && name[2] == 'A')
case '\025': /* ${^UNICODE} */
if (strEQ(name1, "NICODE"))
goto yes;
- if (strEQ(name1, "TF8LOCALE"))
+ if (strEQ(name1, "TF8LOCALE"))
goto yes;
break;
case '\027': /* ${^WARNING_BITS} */
https://perl5.git.perl.org / perl5.git / blobdiff