Use Perl_sv_catpvf to shorten the code (source and object) needed for

[p5sagit/p5-mst-13.2.git] / gv.c

diff --git a/gv.c b/gv.c
index 5fac589..39f4b6a 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -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,10 +575,14 @@ 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);
+    varsv = GvSVn(vargv);
     sv_setpvn(varsv, packname, packname_len);
     sv_catpvn(varsv, "::", 2);
     sv_catpvn(varsv, name, 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"