static const char S_autoload[] = "AUTOLOAD";
static const STRLEN S_autolen = sizeof(S_autoload)-1;
+
+#ifdef PERL_DONT_CREATE_GVSV
+GV *
+Perl_gv_SVadd(pTHX_ GV *gv)
+{
+ if (!gv || SvTYPE((SV*)gv) != SVt_PVGV)
+ Perl_croak(aTHX_ "Bad symbol for scalar");
+ if (!GvSV(gv))
+ GvSV(gv) = NEWSV(72,0);
+ return gv;
+}
+#endif
+
GV *
Perl_gv_AVadd(pTHX_ register GV *gv)
{
if (tmplen < sizeof smallbuf)
tmpbuf = smallbuf;
else
- New(603, tmpbuf, tmplen + 1, char);
+ Newx(tmpbuf, tmplen + 1, char);
/* This is where the debugger's %{"::_<$filename"} hash is created */
tmpbuf[0] = '_';
tmpbuf[1] = '<';
- strcpy(tmpbuf + 2, name);
+ memcpy(tmpbuf + 2, name, tmplen - 1);
gv = *(GV**)hv_fetch(PL_defstash, tmpbuf, tmplen, TRUE);
if (!isGV(gv)) {
gv_init(gv, PL_defstash, tmpbuf, tmplen, FALSE);
- sv_setpv(GvSV(gv), name);
+#ifdef PERL_DONT_CREATE_GVSV
+ GvSV(gv) = newSVpvn(name, tmplen - 2);
+#else
+ sv_setpvn(GvSV(gv), name, tmplen - 2);
+#endif
if (PERLDB_LINE)
hv_magic(GvHVn(gv_AVadd(gv)), Nullgv, PERL_MAGIC_dbfile);
}
} else
Safefree(SvPVX_mutable(gv));
}
- Newz(602, gp, 1, GP);
+ Newxz(gp, 1, GP);
GvGP(gv) = gp_ref(gp);
+#ifdef PERL_DONT_CREATE_GVSV
+ GvSV(gv) = 0;
+#else
GvSV(gv) = NEWSV(72,0);
+#endif
GvLINE(gv) = CopLINE(PL_curcop);
/* XXX Ideally this cast would be replaced with a change to const char*
in the struct. */
case SVt_PVHV:
(void)GvHVn(gv);
break;
+#ifdef PERL_DONT_CREATE_GVSV
+ case SVt_NULL:
+ case SVt_PVCV:
+ case SVt_PVFM:
+ break;
+ default:
+ (void)GvSVn(gv);
+#endif
}
}
/*
* Inheriting AUTOLOAD for non-methods works ... for now.
*/
- if (ckWARN2(WARN_DEPRECATED, WARN_SYNTAX) && !method &&
- (GvCVGEN(gv) || GvSTASH(gv) != stash))
+ if (!method && (GvCVGEN(gv) || GvSTASH(gv) != stash)
+ && ckWARN2(WARN_DEPRECATED, WARN_SYNTAX)
+ )
Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
"Use of inherited AUTOLOAD for non-method %s::%.*s() is deprecated",
packname, (int)len, name);
vargv = *(GV**)hv_fetch(varstash, S_autoload, S_autolen, TRUE);
ENTER;
- if (!isGV(vargv))
+ if (!isGV(vargv)) {
gv_init(vargv, varstash, S_autoload, S_autolen, FALSE);
+#ifdef PERL_DONT_CREATE_GVSV
+ GvSV(vargv) = NEWSV(72,0);
+#endif
+ }
LEAVE;
- varsv = GvSV(vargv);
+ varsv = GvSVn(vargv);
sv_setpvn(varsv, packname, packname_len);
sv_catpvn(varsv, "::", 2);
sv_catpvn(varsv, name, len);
if (namelen + 3 < sizeof smallbuf)
tmpbuf = smallbuf;
else
- New(606, tmpbuf, namelen + 3, char);
+ Newx(tmpbuf, namelen + 3, char);
Copy(name,tmpbuf,namelen,char);
tmpbuf[namelen++] = ':';
tmpbuf[namelen++] = ':';
register const char *namend;
HV *stash = 0;
const I32 add = flags & ~SVf_UTF8;
- (void)full_len;
+
+ PERL_UNUSED_ARG(full_len);
if (*name == '*' && isALPHA(name[1])) /* accidental stringify on a GV? */
name++;
if (len + 3 < sizeof (smallbuf))
tmpbuf = smallbuf;
else
- New(601, tmpbuf, len+3, char);
+ Newx(tmpbuf, len+3, char);
Copy(name, tmpbuf, len, char);
tmpbuf[len++] = ':';
tmpbuf[len++] = ':';
HV *hv;
I32 i;
if (!PL_psig_ptr) {
- Newz(73, PL_psig_ptr, SIG_SIZE, SV*);
- Newz(73, PL_psig_name, SIG_SIZE, SV*);
- Newz(73, PL_psig_pend, SIG_SIZE, int);
+ Newxz(PL_psig_ptr, SIG_SIZE, SV*);
+ Newxz(PL_psig_name, SIG_SIZE, SV*);
+ Newxz(PL_psig_pend, SIG_SIZE, int);
}
GvMULTI_on(gv);
hv = GvHVn(gv);
goto ro_magicalize;
case ':':
- sv_setpv(GvSV(gv),PL_chopset);
+ sv_setpv(GvSVn(gv),PL_chopset);
goto magicalize;
case '?':
#ifdef COMPLEX_STATUS
- SvUPGRADE(GvSV(gv), SVt_PVLV);
+ SvUPGRADE(GvSVn(gv), SVt_PVLV);
#endif
goto magicalize;
now (rather than going to magicalize)
*/
- sv_magic(GvSV(gv), (SV*)gv, PERL_MAGIC_sv, name, len);
+ sv_magic(GvSVn(gv), (SV*)gv, PERL_MAGIC_sv, name, len);
if (sv_type == SVt_PVHV)
require_errno(gv);
"$%c is no longer supported", *name);
break;
case '|':
- sv_setiv(GvSV(gv), (IV)(IoFLAGS(GvIOp(PL_defoutgv)) & IOf_FLUSH) != 0);
+ sv_setiv(GvSVn(gv), (IV)(IoFLAGS(GvIOp(PL_defoutgv)) & IOf_FLUSH) != 0);
goto magicalize;
case '+':
case '8':
case '9':
ro_magicalize:
- SvREADONLY_on(GvSV(gv));
+ SvREADONLY_on(GvSVn(gv));
/* FALL THROUGH */
case '[':
case '^':
case '\024': /* $^T */
case '\027': /* $^W */
magicalize:
- sv_magic(GvSV(gv), (SV*)gv, PERL_MAGIC_sv, name, len);
+ sv_magic(GvSVn(gv), (SV*)gv, PERL_MAGIC_sv, name, len);
break;
case '\014': /* $^L */
- sv_setpvn(GvSV(gv),"\f",1);
- PL_formfeed = GvSV(gv);
+ sv_setpvn(GvSVn(gv),"\f",1);
+ PL_formfeed = GvSVn(gv);
break;
case ';':
- sv_setpvn(GvSV(gv),"\034",1);
+ sv_setpvn(GvSVn(gv),"\034",1);
break;
case ']':
{
- SV * const sv = GvSV(gv);
+ SV * const sv = GvSVn(gv);
if (!sv_derived_from(PL_patchlevel, "version"))
(void *)upg_version(PL_patchlevel);
GvSV(gv) = vnumify(PL_patchlevel);
break;
case '\026': /* $^V */
{
- SV * const sv = GvSV(gv);
+ SV * const sv = GvSVn(gv);
GvSV(gv) = new_version(PL_patchlevel);
SvREADONLY_on(GvSV(gv));
SvREFCNT_dec(sv);
void
Perl_gv_efullname4(pTHX_ SV *sv, const GV *gv, const char *prefix, bool keepmain)
{
- const GV *egv = GvEGV(gv);
- if (!egv)
- egv = gv;
- gv_fullname4(sv, egv, prefix, keepmain);
+ const GV * const egv = GvEGV(gv);
+ gv_fullname4(sv, egv ? egv : gv, prefix, keepmain);
}
void
if (!gv)
lim = DESTROY_amg; /* Skip overloading entries. */
+#ifdef PERL_DONT_CREATE_GVSV
+ else if (!sv) {
+ /* Equivalent to !SvTRUE and !SvOK */
+ }
+#endif
else if (SvTRUE(sv))
amt.fallback=AMGfallYES;
else if (SvOK(sv))
knowing *which* methods were declared as overloaded. */
/* GvSV contains the name of the method. */
GV *ngv = Nullgv;
+ SV *gvsv = GvSV(gv);
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)),
+ if (!gvsv || !SvPOK(gvsv)
+ || !(ngv = gv_fetchmethod_autoload(stash, SvPVX_const(gvsv),
FALSE)))
{
/* Can be an import stub (created by "can"). */
- SV *gvsv = GvSV(gv);
- const char * const name = SvPOK(gvsv) ? SvPVX_const(gvsv) : "???";
+ const char * const name = (gvsv && SvPOK(gvsv)) ? SvPVX_const(gvsv) : "???";
Perl_croak(aTHX_ "%s method \"%.256s\" overloading \"%s\" "\
"in package \"%.256s\"",
(GvCVGEN(gv) ? "Stub found while resolving"
"Inherited AUTOLOAD for a non-method deprecated", since
our caller is going through a function call, not a method call.
So return the CV for AUTOLOAD, setting $AUTOLOAD. */
- GV *gv = gv_fetchmethod(stash, PL_AMG_names[id]);
+ GV * const gv = gv_fetchmethod(stash, PL_AMG_names[id]);
if (gv && GvCV(gv))
return GvCV(gv);
* SV* ref causes confusion with the interpreter variable of
* the same name
*/
- SV* tmpRef=SvRV(left);
+ SV* const tmpRef=SvRV(left);
if (!SvROK(tmpRef) && SvTYPE(tmpRef) <= SVt_PVMG) {
/*
* Just to be extra cautious. Maybe in some
* additional cases sv_setsv is safe, too.
*/
- SV* newref = newSVsv(tmpRef);
+ SV* const newref = newSVsv(tmpRef);
SvOBJECT_on(newref);
SvSTASH_set(newref, (HV*)SvREFCNT_inc(SvSTASH(tmpRef)));
return newref;
case abs_amg:
if ((cvp[off1=lt_amg] || cvp[off1=ncmp_amg])
&& ((cv = cvp[off=neg_amg]) || (cv = cvp[off=subtr_amg]))) {
- SV* nullsv=sv_2mortal(newSViv(0));
+ SV* const nullsv=sv_2mortal(newSViv(0));
if (off1==lt_amg) {
- SV* lessp = amagic_call(left,nullsv,
+ SV* const lessp = amagic_call(left,nullsv,
lt_amg,AMGf_noright);
logic = SvTRUE(lessp);
} else {
- SV* lessp = amagic_call(left,nullsv,
+ SV* const lessp = amagic_call(left,nullsv,
ncmp_amg,AMGf_noright);
logic = (SvNV(lessp) < 0);
}
Perl_is_gv_magical_sv(pTHX_ SV *name, U32 flags)
{
STRLEN len;
- const char *temp = SvPV_const(name, len);
+ const char * const temp = SvPV_const(name, len);
return is_gv_magical(temp, len, flags);
}
projects / p5sagit/p5-mst-13.2.git / blobdiff