diff options
author | Nicholas Clark <nick@ccl4.org> | 2005-06-29 15:58:14 +0000 |
---|---|---|
committer | Nicholas Clark <nick@ccl4.org> | 2005-06-29 15:58:14 +0000 |
commit | c69033f2a629160559f680da8e4e5a7e3c4c3a0c (patch) | |
tree | d19b6ca86b0f5cbbbb1e078ab96eac111df03dfd /gv.c | |
parent | 9dc0b5dcb80b5128172acb8c4bd670aa72142821 (diff) | |
download | perl-c69033f2a629160559f680da8e4e5a7e3c4c3a0c.tar.gz |
First stab at not automatically creating an unused SV for GvSV
Enable it with -DPERL_DONT_CREATE_GVSV.
Currently if enabled 22 test scripts have failures, so still some way
to go.
p4raw-id: //depot/perl@25009
Diffstat (limited to 'gv.c')
-rw-r--r-- | gv.c | 72 |
1 files changed, 55 insertions, 17 deletions
@@ -37,6 +37,19 @@ Perl stores its global variables. 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) { @@ -96,7 +109,11 @@ Perl_gv_fetchfile(pTHX_ const char *name) 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); } @@ -124,7 +141,11 @@ Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi) } Newz(602, 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. */ @@ -171,6 +192,14 @@ S_gv_init_sv(pTHX_ GV *gv, I32 sv_type) 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 } } @@ -546,8 +575,12 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method) 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); sv_setpvn(varsv, packname, packname_len); @@ -1001,12 +1034,12 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, 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; @@ -1018,7 +1051,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, 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); @@ -1038,7 +1071,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, "$%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 '+': @@ -1059,7 +1092,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, case '8': case '9': ro_magicalize: - SvREADONLY_on(GvSV(gv)); + SvREADONLY_on(GvSVn(gv)); /* FALL THROUGH */ case '[': case '^': @@ -1087,19 +1120,19 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, 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); @@ -1109,7 +1142,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, 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); @@ -1379,6 +1412,11 @@ Perl_Gv_AMupdate(pTHX_ HV *stash) 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)) @@ -1414,17 +1452,17 @@ Perl_Gv_AMupdate(pTHX_ HV *stash) 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" |