Static cleanup in pp_sort.c

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

diff --git a/gv.c b/gv.c
index 5c1becb..4187c18 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -157,11 +157,36 @@ Perl_gv_const_sv(pTHX_ GV *gv)
     return SvROK(gv) ? SvRV(gv) : NULL;
 }
 
+GP *
+Perl_newGP(pTHX_ GV *const gv)
+{
+    GP *gp;
+    const char *const file = CopFILE(PL_curcop) ? CopFILE(PL_curcop) : "";
+    STRLEN len = strlen(file);
+    U32 hash;
+
+    PERL_HASH(hash, file, len);
+
+    Newxz(gp, 1, GP);
+
+#ifndef PERL_DONT_CREATE_GVSV
+    gp->gv_sv = newSV(0);
+#endif
+
+    gp->gp_line = CopLINE(PL_curcop);
+    /* XXX Ideally this cast would be replaced with a change to const char*
+       in the struct.  */
+    gp->gp_file_hek = share_hek(file, len, hash);
+    gp->gp_egv = gv;
+    gp->gp_refcnt = 1;
+
+    return gp;
+}
+
 void
 Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi)
 {
     dVAR;
-    register GP *gp;
     const U32 old_type = SvTYPE(gv);
     const bool doproto = old_type > SVt_NULL;
     const char * const proto = (doproto && SvPOK(gv)) ? SvPVX_const(gv) : NULL;
@@ -179,6 +204,7 @@ Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi)
        case SVt_PVIO:
             Perl_croak(aTHX_ "Cannot convert a reference to %s to typeglob",
                       sv_reftype(has_constant, 0));
+       default: NOOP;
        }
        SvRV_set(gv, NULL);
        SvROK_off(gv);
@@ -198,20 +224,9 @@ Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi)
        } else
            Safefree(SvPVX_mutable(gv));
     }
-    Newxz(gp, 1, GP);
     SvSCREAM_on(gv);
-    GvGP(gv) = gp_ref(gp);
-#ifdef PERL_DONT_CREATE_GVSV
-    GvSV(gv) = NULL;
-#else
-    GvSV(gv) = newSV(0);
-#endif
-    GvLINE(gv) = CopLINE(PL_curcop);
-    /* XXX Ideally this cast would be replaced with a change to const char*
-       in the struct.  */
-    GvFILE(gv) = CopFILE(PL_curcop) ? CopFILE(PL_curcop) : (char *) "";
-    GvCVGEN(gv) = 0;
-    GvEGV(gv) = gv;
+
+    GvGP(gv) = Perl_newGP(aTHX_ gv);
     GvSTASH(gv) = stash;
     if (stash)
        Perl_sv_add_backref(aTHX_ (SV*)stash, (SV*)gv);
@@ -372,7 +387,7 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
            if (!basestash) {
                if (ckWARN(WARN_MISC))
                    Perl_warner(aTHX_ packWARN(WARN_MISC), "Can't locate package %"SVf" for @%s::ISA",
-                       sv, hvname);
+                       (void*)sv, hvname);
                continue;
            }
            gv = gv_fetchmeth(basestash, name, len,
@@ -575,7 +590,7 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method)
     GV* vargv;
     SV* varsv;
     const char *packname = "";
-    STRLEN packname_len;
+    STRLEN packname_len = 0;
 
     if (len == S_autolen && strnEQ(name, S_autoload, S_autolen))
        return NULL;
@@ -799,7 +814,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
                char smallbuf[128];
                char *tmpbuf;
 
-               if (len + 3 < sizeof (smallbuf))
+               if (len + 3 < (I32)sizeof (smallbuf))
                    tmpbuf = smallbuf;
                else
                    Newx(tmpbuf, len+3, char);
@@ -929,10 +944,16 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
                  : sv_type == SVt_PVAV ? "@"
                  : sv_type == SVt_PVHV ? "%"
                  : ""), name);
+           GV *gv;
            if (USE_UTF8_IN_NAMES)
                SvUTF8_on(err);
            qerror(err);
-           stash = GvHV(gv_fetchpvn_flags("<none>::", 8, GV_ADDMULTI, SVt_PVHV));
+           gv = gv_fetchpvn_flags("<none>::", 8, GV_ADDMULTI, SVt_PVHV);
+           if(!gv) {
+               /* symbol table under destruction */
+               return NULL;
+           }   
+           stash = GvHV(gv);
        }
        else
            return NULL;
@@ -974,7 +995,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
     if (len > 1) {
 #ifndef EBCDIC
        if (*name > 'V' ) {
-           /*EMPTY*/;
+           NOOP;
            /* Nothing else to do.
               The compiler will probably turn the switch statement into a
               branch table. Make sure we avoid even that small overhead for
@@ -988,6 +1009,9 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
                if (strEQ(name2, "RGV")) {
                    IoFLAGS(GvIOn(gv)) |= IOf_ARGV|IOf_START;
                }
+               else if (strEQ(name2, "RGVOUT")) {
+                   GvMULTI_on(gv);
+               }
                break;
            case 'E':
                if (strnEQ(name2, "XPORT", 5))
@@ -1299,7 +1323,7 @@ Perl_newIO(pTHX)
 }
 
 void
-Perl_gv_check(pTHX_ HV *stash)
+Perl_gv_check(pTHX_ const HV *stash)
 {
     dVAR;
     register I32 i;
@@ -1408,6 +1432,7 @@ Perl_gp_free(pTHX_ GV *gv)
         return;
     }
 
+    unshare_hek(gp->gp_file_hek);
     SvREFCNT_dec(gp->gp_sv);
     SvREFCNT_dec(gp->gp_av);
     /* FIXME - another reference loop GV -> symtab -> GV ?
@@ -1453,13 +1478,16 @@ Perl_Gv_AMupdate(pTHX_ HV *stash)
 {
   dVAR;
   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
-      && amtp->was_ok_sub == PL_sub_generation)
-      return (bool)AMT_OVERLOADED(amtp);
-  sv_unmagic((SV*)stash, PERL_MAGIC_overload_table);
+  if (mg) {
+      const AMT * const amtp = (AMT*)mg->mg_ptr;
+      if (amtp->was_ok_am == PL_amagic_generation
+         && amtp->was_ok_sub == PL_sub_generation) {
+         return (bool)AMT_OVERLOADED(amtp);
+      }
+      sv_unmagic((SV*)stash, PERL_MAGIC_overload_table);
+  }
 
   DEBUG_o( Perl_deb(aTHX_ "Recalcing overload magic in package %s\n",HvNAME_get(stash)) );
 
@@ -1484,7 +1512,7 @@ Perl_Gv_AMupdate(pTHX_ HV *stash)
        lim = DESTROY_amg;              /* Skip overloading entries. */
 #ifdef PERL_DONT_CREATE_GVSV
     else if (!sv) {
-       /*EMPTY*/;   /* Equivalent to !SvTRUE and !SvOK  */
+       NOOP;   /* Equivalent to !SvTRUE and !SvOK  */
     }
 #endif
     else if (SvTRUE(sv))
@@ -1526,7 +1554,7 @@ Perl_Gv_AMupdate(pTHX_ HV *stash)
 
                DEBUG_o( Perl_deb(aTHX_ "Resolving method \"%"SVf256\
                        "\" for overloaded \"%s\" in package \"%.256s\"\n",
-                            GvSV(gv), cp, hvname) );
+                            (void*)GvSV(gv), cp, hvname) );
                if (!gvsv || !SvPOK(gvsv)
                    || !(ngv = gv_fetchmethod_autoload(stash, SvPVX_const(gvsv),
                                                       FALSE)))
@@ -1586,6 +1614,7 @@ Perl_gv_handler(pTHX_ HV *stash, I32 id)
        Gv_AMupdate(stash);
        mg = mg_find((SV*)stash, PERL_MAGIC_overload_table);
     }
+    assert(mg);
     amtp = (AMT*)mg->mg_ptr;
     if ( amtp->was_ok_am != PL_amagic_generation
         || amtp->was_ok_sub != PL_sub_generation )
@@ -1824,7 +1853,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
        if (amtp && amtp->fallback >= AMGfallYES) {
          DEBUG_o( Perl_deb(aTHX_ "%s", SvPVX_const(msg)) );
        } else {
-         Perl_croak(aTHX_ "%"SVf, msg);
+         Perl_croak(aTHX_ "%"SVf, (void*)msg);
        }
        return NULL;
       }
@@ -2117,6 +2146,7 @@ Perl_gv_name_set(pTHX_ GV *gv, const char *name, U32 len, U32 flags)
     dVAR;
     U32 hash;
 
+    assert(name);
     PERL_UNUSED_ARG(flags);
 
     if (len > I32_MAX)
@@ -2127,7 +2157,7 @@ Perl_gv_name_set(pTHX_ GV *gv, const char *name, U32 len, U32 flags)
     }
 
     PERL_HASH(hash, name, len);
-    GvNAME_HEK(gv) = name ? share_hek(name, len, hash) : 0;
+    GvNAME_HEK(gv) = share_hek(name, len, hash);
 }
 
 /*