Because name is always NUL terminated we can incorporate length
[p5sagit/p5-mst-13.2.git] / gv.c
diff --git a/gv.c b/gv.c
index 0bedea4..b68f212 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -1,6 +1,7 @@
 /*    gv.c
  *
- *    Copyright (c) 1991-2003, Larry Wall
+ *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
+ *    2000, 2001, 2002, 2003, 2004, by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
 
 /*
 =head1 GV Functions
+
+A GV is a structure which corresponds to to a Perl typeglob, ie *foo.
+It is a structure that holds a pointer to a scalar, an array, a hash etc,
+corresponding to $foo, @foo, %foo.
+
+GVs are usually found as values in stashes (symbol table hashes) where
+Perl stores its global variables.
+
+=cut
 */
 
 #include "EXTERN.h"
@@ -193,6 +203,10 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
            return 0;
     }
 
+    if (!HvNAME(stash))
+      Perl_croak(aTHX_
+                "Can't use anonymous symbol table for method lookup");
+
     if ((level > 100) || (level < -100))
        Perl_croak(aTHX_ "Recursive inheritance detected while looking for method '%s' in package '%s'",
              name, HvNAME(stash));
@@ -562,9 +576,9 @@ S_require_errno(pTHX_ GV *gv)
 =for apidoc gv_stashpv
 
 Returns a pointer to the stash for a specified package.  C<name> should
-be a valid UTF-8 string.  If C<create> is set then the package will be
-created if it does not already exist.  If C<create> is not set and the
-package does not exist then NULL is returned.
+be a valid UTF-8 string and must be null-terminated.  If C<create> is set
+then the package will be created if it does not already exist.  If C<create>
+is not set and the package does not exist then NULL is returned.
 
 =cut
 */
@@ -575,6 +589,18 @@ Perl_gv_stashpv(pTHX_ const char *name, I32 create)
     return gv_stashpvn(name, strlen(name), create);
 }
 
+/*
+=for apidoc gv_stashpvn
+
+Returns a pointer to the stash for a specified package.  C<name> should
+be a valid UTF-8 string.  The C<namelen> parameter indicates the length of
+the C<name>, in bytes.  If C<create> is set then the package will be
+created if it does not already exist.  If C<create> is not set and the
+package does not exist then NULL is returned.
+
+=cut
+*/
+
 HV*
 Perl_gv_stashpvn(pTHX_ const char *name, U32 namelen, I32 create)
 {
@@ -687,8 +713,6 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type)
        }
     }
     len = namend - name;
-    if (!len)
-       len = 1;
 
     /* No stash in name, so see how we can default */
 
@@ -696,35 +720,43 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type)
        if (isIDFIRST_lazy(name)) {
            bool global = FALSE;
 
-           if (isUPPER(*name)) {
-               if (*name == 'S' && (
-                   strEQ(name, "SIG") ||
-                   strEQ(name, "STDIN") ||
-                   strEQ(name, "STDOUT") ||
-                   strEQ(name, "STDERR")))
+           /* name is always \0 terminated, and initial \0 wouldn't return
+              true from isIDFIRST_lazy, so we know that name[1] is defined  */
+           switch (name[1]) {
+           case '\0':
+               if (*name == '_')
+                   global = TRUE;
+               break;
+           case 'N':
+               if (strEQ(name, "INC") || strEQ(name, "ENV"))
                    global = TRUE;
-               else if (*name == 'I' && strEQ(name, "INC"))
+               break;
+           case 'I':
+               if (strEQ(name, "SIG"))
                    global = TRUE;
-               else if (*name == 'E' && strEQ(name, "ENV"))
+               break;
+           case 'T':
+               if (strEQ(name, "STDIN") || strEQ(name, "STDOUT") ||
+                   strEQ(name, "STDERR"))
                    global = TRUE;
-               else if (*name == 'A' && (
-                 strEQ(name, "ARGV") ||
-                 strEQ(name, "ARGVOUT")))
+               break;
+           case 'R':
+               if (strEQ(name, "ARGV") || strEQ(name, "ARGVOUT"))
                    global = TRUE;
+               break;
            }
-           else if (*name == '_' && !name[1])
-               global = TRUE;
 
            if (global)
                stash = PL_defstash;
-           else if ((COP*)PL_curcop == &PL_compiling) {
+           else if (IN_PERL_COMPILETIME) {
                stash = PL_curstash;
                if (add && (PL_hints & HINT_STRICT_VARS) &&
                    sv_type != SVt_PVCV &&
                    sv_type != SVt_PVGV &&
                    sv_type != SVt_PVFM &&
                    sv_type != SVt_PVIO &&
-                   !(len == 1 && sv_type == SVt_PV && strchr("ab",*name)) )
+                   !(len == 1 && sv_type == SVt_PV &&
+                     (*name == 'a' || *name == 'b')) )
                {
                    gvp = (GV**)hv_fetch(stash,name,len,0);
                    if (!gvp ||
@@ -758,14 +790,19 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type)
 
     if (!stash) {
        if (add) {
-           qerror(Perl_mess(aTHX_
+           register SV *err = Perl_mess(aTHX_
                 "Global symbol \"%s%s\" requires explicit package name",
                 (sv_type == SVt_PV ? "$"
                  : sv_type == SVt_PVAV ? "@"
                  : sv_type == SVt_PVHV ? "%"
-                 : ""), name));
+                 : ""), name);
+           if (USE_UTF8_IN_NAMES)
+               SvUTF8_on(err);
+           qerror(err);
+           stash = GvHV(gv_fetchpv("<none>::", GV_ADDMULTI, SVt_PVHV));
        }
-       return Nullgv;
+       else
+           return Nullgv;
     }
 
     if (!SvREFCNT(stash))      /* symbol table under destruction */
@@ -799,263 +836,259 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type)
         GvMULTI_on(gv) ;
 
     /* set up magic where warranted */
-    switch (*name) {
-    case 'A':
-       if (strEQ(name, "ARGV")) {
-           IoFLAGS(GvIOn(gv)) |= IOf_ARGV|IOf_START;
-       }
-       break;
-    case 'E':
-       if (strnEQ(name, "EXPORT", 6))
-           GvMULTI_on(gv);
-       break;
-    case 'I':
-       if (strEQ(name, "ISA")) {
-           AV* av = GvAVn(gv);
-           GvMULTI_on(gv);
-           sv_magic((SV*)av, (SV*)gv, PERL_MAGIC_isa, Nullch, 0);
-           /* NOTE: No support for tied ISA */
-           if ((add & GV_ADDMULTI) && strEQ(nambeg,"AnyDBM_File::ISA")
-               && AvFILLp(av) == -1)
+    if (len > 1) {
+       if (*name > 'V' ) {
+           /* 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
+              the common case of lower case variable names.  */
+       } else {
+           const char *name2 = name + 1;
+           switch (*name) {
+           case 'A':
+               if (strEQ(name2, "RGV")) {
+                   IoFLAGS(GvIOn(gv)) |= IOf_ARGV|IOf_START;
+               }
+               break;
+           case 'E':
+               if (strnEQ(name2, "XPORT", 5))
+                   GvMULTI_on(gv);
+               break;
+           case 'I':
+               if (strEQ(name2, "SA")) {
+                   AV* av = GvAVn(gv);
+                   GvMULTI_on(gv);
+                   sv_magic((SV*)av, (SV*)gv, PERL_MAGIC_isa, Nullch, 0);
+                   /* NOTE: No support for tied ISA */
+                   if ((add & GV_ADDMULTI) && strEQ(nambeg,"AnyDBM_File::ISA")
+                       && AvFILLp(av) == -1)
+                       {
+                           char *pname;
+                           av_push(av, newSVpvn(pname = "NDBM_File",9));
+                           gv_stashpvn(pname, 9, TRUE);
+                           av_push(av, newSVpvn(pname = "DB_File",7));
+                           gv_stashpvn(pname, 7, TRUE);
+                           av_push(av, newSVpvn(pname = "GDBM_File",9));
+                           gv_stashpvn(pname, 9, TRUE);
+                           av_push(av, newSVpvn(pname = "SDBM_File",9));
+                           gv_stashpvn(pname, 9, TRUE);
+                           av_push(av, newSVpvn(pname = "ODBM_File",9));
+                           gv_stashpvn(pname, 9, TRUE);
+                       }
+               }
+               break;
+           case 'O':
+               if (strEQ(name2, "VERLOAD")) {
+                   HV* hv = GvHVn(gv);
+                   GvMULTI_on(gv);
+                   hv_magic(hv, Nullgv, PERL_MAGIC_overload);
+               }
+               break;
+           case 'S':
+               if (strEQ(name2, "IG")) {
+                   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);
+                   }
+                   GvMULTI_on(gv);
+                   hv = GvHVn(gv);
+                   hv_magic(hv, Nullgv, PERL_MAGIC_sig);
+                   for (i = 1; i < SIG_SIZE; i++) {
+                       SV ** init;
+                       init = hv_fetch(hv, PL_sig_name[i], strlen(PL_sig_name[i]), 1);
+                       if (init)
+                           sv_setsv(*init, &PL_sv_undef);
+                       PL_psig_ptr[i] = 0;
+                       PL_psig_name[i] = 0;
+                       PL_psig_pend[i] = 0;
+                   }
+               }
+               break;
+           case 'V':
+               if (strEQ(name2, "ERSION"))
+                   GvMULTI_on(gv);
+               break;
+           case '\005':        /* $^ENCODING */
+               if (strEQ(name2, "NCODING"))
+                   goto magicalize;
+               break;
+           case '\017':        /* $^OPEN */
+               if (strEQ(name2, "PEN"))
+                   goto magicalize;
+               break;
+           case '\024':        /* ${^TAINT} */
+               if (strEQ(name2, "AINT"))
+                   goto ro_magicalize;
+               break;
+           case '\025':        /* $^UNICODE */
+               if (strEQ(name2, "NICODE")) 
+                   goto ro_magicalize;
+               break;
+           case '\027':        /* $^WARNING_BITS */
+               if (strEQ(name2, "ARNING_BITS"))
+                   goto magicalize;
+               break;
+           case '1':
+           case '2':
+           case '3':
+           case '4':
+           case '5':
+           case '6':
+           case '7':
+           case '8':
+           case '9':
            {
-               char *pname;
-               av_push(av, newSVpvn(pname = "NDBM_File",9));
-               gv_stashpvn(pname, 9, TRUE);
-               av_push(av, newSVpvn(pname = "DB_File",7));
-               gv_stashpvn(pname, 7, TRUE);
-               av_push(av, newSVpvn(pname = "GDBM_File",9));
-               gv_stashpvn(pname, 9, TRUE);
-               av_push(av, newSVpvn(pname = "SDBM_File",9));
-               gv_stashpvn(pname, 9, TRUE);
-               av_push(av, newSVpvn(pname = "ODBM_File",9));
-               gv_stashpvn(pname, 9, TRUE);
-           }
-       }
-       break;
-    case 'O':
-        if (strEQ(name, "OVERLOAD")) {
-            HV* hv = GvHVn(gv);
-            GvMULTI_on(gv);
-            hv_magic(hv, Nullgv, PERL_MAGIC_overload);
-        }
-        break;
-    case 'S':
-       if (strEQ(name, "SIG")) {
-           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);
+               /* ensures variable is only digits */
+               /* ${"1foo"} fails this test (and is thus writeable) */
+               /* added by japhy, but borrowed from is_gv_magical */
+               const char *end = name + len;
+               while (--end > name) {
+                   if (!isDIGIT(*end)) return gv;
+               }
+               goto ro_magicalize;
            }
-           GvMULTI_on(gv);
-           hv = GvHVn(gv);
-           hv_magic(hv, Nullgv, PERL_MAGIC_sig);
-           for (i = 1; i < SIG_SIZE; i++) {
-               SV ** init;
-               init = hv_fetch(hv, PL_sig_name[i], strlen(PL_sig_name[i]), 1);
-               if (init)
-                   sv_setsv(*init, &PL_sv_undef);
-               PL_psig_ptr[i] = 0;
-               PL_psig_name[i] = 0;
-               PL_psig_pend[i] = 0;
            }
        }
-       break;
-    case 'V':
-       if (strEQ(name, "VERSION"))
-           GvMULTI_on(gv);
-       break;
-
-    case '&':
-    case '`':
-    case '\'':
-       if (
-           len > 1 ||
-           sv_type == SVt_PVAV ||
-           sv_type == SVt_PVHV ||
-           sv_type == SVt_PVCV ||
-           sv_type == SVt_PVFM ||
-           sv_type == SVt_PVIO
-       ) { break; }
-       PL_sawampersand = TRUE;
-       goto ro_magicalize;
-
-    case ':':
-       if (len > 1)
-           break;
-       sv_setpv(GvSV(gv),PL_chopset);
-       goto magicalize;
-
-    case '?':
-       if (len > 1)
-           break;
+    } else {
+       /* Names of length 1.  (Or 0. But name is NUL terminated, so that will
+          be case '\0' in this switch statement (ie a default case)  */
+       switch (*name) {
+       case '&':
+       case '`':
+       case '\'':
+           if (
+               sv_type == SVt_PVAV ||
+               sv_type == SVt_PVHV ||
+               sv_type == SVt_PVCV ||
+               sv_type == SVt_PVFM ||
+               sv_type == SVt_PVIO
+               ) { break; }
+           PL_sawampersand = TRUE;
+           goto ro_magicalize;
+
+       case ':':
+           sv_setpv(GvSV(gv),PL_chopset);
+           goto magicalize;
+
+       case '?':
 #ifdef COMPLEX_STATUS
-       (void)SvUPGRADE(GvSV(gv), SVt_PVLV);
+           (void)SvUPGRADE(GvSV(gv), SVt_PVLV);
 #endif
-       goto magicalize;
+           goto magicalize;
 
-    case '!':
-       if (len > 1)
-           break;
+       case '!':
 
-       /* If %! has been used, automatically load Errno.pm.
-          The require will itself set errno, so in order to
-          preserve its value we have to set up the magic
-          now (rather than going to magicalize)
-       */
+           /* If %! has been used, automatically load Errno.pm.
+              The require will itself set errno, so in order to
+              preserve its value we have to set up the magic
+              now (rather than going to magicalize)
+           */
 
-       sv_magic(GvSV(gv), (SV*)gv, PERL_MAGIC_sv, name, len);
+           sv_magic(GvSV(gv), (SV*)gv, PERL_MAGIC_sv, name, len);
 
-       if (sv_type == SVt_PVHV)
-           require_errno(gv);
+           if (sv_type == SVt_PVHV)
+               require_errno(gv);
 
-       break;
-    case '-':
-       if (len > 1)
            break;
-       else {
+       case '-':
+       {
             AV* av = GvAVn(gv);
             sv_magic((SV*)av, Nullsv, PERL_MAGIC_regdata, Nullch, 0);
            SvREADONLY_on(av);
-        }
-       goto magicalize;
-    case '#':
-    case '*':
-       if (ckWARN2(WARN_DEPRECATED, WARN_SYNTAX) && len == 1 && sv_type == SVt_PV)
-           Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX), "Use of $%s is deprecated", name);
-       /* FALL THROUGH */
-    case '[':
-    case '^':
-    case '~':
-    case '=':
-    case '%':
-    case '.':
-    case '(':
-    case ')':
-    case '<':
-    case '>':
-    case ',':
-    case '\\':
-    case '/':
-    case '\001':       /* $^A */
-    case '\003':       /* $^C */
-    case '\004':       /* $^D */
-    case '\006':       /* $^F */
-    case '\010':       /* $^H */
-    case '\011':       /* $^I, NOT \t in EBCDIC */
-    case '\016':        /* $^N */
-    case '\020':       /* $^P */
-       if (len > 1)
-           break;
-       goto magicalize;
-    case '|':
-       if (len > 1)
-           break;
-       sv_setiv(GvSV(gv), (IV)(IoFLAGS(GvIOp(PL_defoutgv)) & IOf_FLUSH) != 0);
-       goto magicalize;
-    case '\005':       /* $^E && $^ENCODING */
-       if (len > 1 && strNE(name, "\005NCODING"))
-           break;
-       goto magicalize;
-
-    case '\017':       /* $^O & $^OPEN */
-       if (len > 1 && strNE(name, "\017PEN"))
-           break;
-       goto magicalize;
-    case '\023':       /* $^S */
-       if (len > 1)
-           break;
-       goto ro_magicalize;
-    case '\024':       /* $^T, ${^TAINT} */
-        if (len == 1)
-            goto magicalize;
-        else if (strEQ(name, "\024AINT"))
-            goto ro_magicalize;
-        else
-            break;
-    case '\025':
-        if (len > 1 && strNE(name, "\025NICODE")) 
-           break;
-       goto ro_magicalize;
-
-    case '\027':       /* $^W & $^WARNING_BITS */
-       if (len > 1
-           && strNE(name, "\027ARNING_BITS")
-           )
-           break;
-       goto magicalize;
-
-    case '+':
-       if (len > 1)
+           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;
-       else {
-            AV* av = GvAVn(gv);
+       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;
+       case '|':
+           sv_setiv(GvSV(gv), (IV)(IoFLAGS(GvIOp(PL_defoutgv)) & IOf_FLUSH) != 0);
+           goto magicalize;
+
+       case '+':
+       {
+           AV* av = GvAVn(gv);
             sv_magic((SV*)av, (SV*)av, PERL_MAGIC_regdata, Nullch, 0);
            SvREADONLY_on(av);
-        }
-       /* FALL THROUGH */
-    case '1':
-    case '2':
-    case '3':
-    case '4':
-    case '5':
-    case '6':
-    case '7':
-    case '8':
-    case '9':
-       /* ensures variable is only digits */
-       /* ${"1foo"} fails this test (and is thus writeable) */
-       /* added by japhy, but borrowed from is_gv_magical */
-
-       if (len > 1) {
-           const char *end = name + len;
-           while (--end > name) {
-               if (!isDIGIT(*end)) return gv;
-           }
+           /* FALL THROUGH */
        }
+       case '\023':    /* $^S */
+       case '1':
+       case '2':
+       case '3':
+       case '4':
+       case '5':
+       case '6':
+       case '7':
+       case '8':
+       case '9':
+       ro_magicalize:
+           SvREADONLY_on(GvSV(gv));
+           /* FALL THROUGH */
+       case '[':
+       case '^':
+       case '~':
+       case '=':
+       case '%':
+       case '.':
+       case '(':
+       case ')':
+       case '<':
+       case '>':
+       case ',':
+       case '\\':
+       case '/':
+       case '\001':    /* $^A */
+       case '\003':    /* $^C */
+       case '\004':    /* $^D */
+       case '\005':    /* $^E */
+       case '\006':    /* $^F */
+       case '\010':    /* $^H */
+       case '\011':    /* $^I, NOT \t in EBCDIC */
+       case '\016':    /* $^N */
+       case '\017':    /* $^O */
+       case '\020':    /* $^P */
+       case '\024':    /* $^T */
+       case '\027':    /* $^W */
+       magicalize:
+           sv_magic(GvSV(gv), (SV*)gv, PERL_MAGIC_sv, name, len);
+           break;
 
-      ro_magicalize:
-       SvREADONLY_on(GvSV(gv));
-      magicalize:
-       sv_magic(GvSV(gv), (SV*)gv, PERL_MAGIC_sv, name, len);
-       break;
-
-    case '\014':       /* $^L */
-       if (len > 1)
+       case '\014':    /* $^L */
+           sv_setpv(GvSV(gv),"\f");
+           PL_formfeed = GvSV(gv);
            break;
-       sv_setpv(GvSV(gv),"\f");
-       PL_formfeed = GvSV(gv);
-       break;
-    case ';':
-       if (len > 1)
+       case ';':
+           sv_setpv(GvSV(gv),"\034");
            break;
-       sv_setpv(GvSV(gv),"\034");
-       break;
-    case ']':
-       if (len == 1) {
+       case ']':
+       {
            SV *sv = GvSV(gv);
-           (void)SvUPGRADE(sv, SVt_PVNV);
-           Perl_sv_setpvf(aTHX_ sv,
-#if defined(PERL_SUBVERSION) && (PERL_SUBVERSION > 0)
-                           "%8.6"
-#else
-                           "%5.3"
-#endif
-                           NVff,
-                           SvNVX(PL_patchlevel));
-           SvNVX(sv) = SvNVX(PL_patchlevel);
-           SvNOK_on(sv);
-           SvREADONLY_on(sv);
+           if (!sv_derived_from(PL_patchlevel, "version"))
+               (void *)upg_version(PL_patchlevel);
+           GvSV(gv) = vnumify(PL_patchlevel);
+           SvREADONLY_on(GvSV(gv));
+           SvREFCNT_dec(sv);
        }
        break;
-    case '\026':       /* $^V */
-       if (len == 1) {
+       case '\026':    /* $^V */
+       {
            SV *sv = GvSV(gv);
-           GvSV(gv) = SvREFCNT_inc(PL_patchlevel);
+           GvSV(gv) = new_version(PL_patchlevel);
+           SvREADONLY_on(GvSV(gv));
            SvREFCNT_dec(sv);
        }
        break;
+       }
     }
     return gv;
 }
@@ -1063,14 +1096,20 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type)
 void
 Perl_gv_fullname4(pTHX_ SV *sv, GV *gv, const char *prefix, bool keepmain)
 {
+    char *name;
     HV *hv = GvSTASH(gv);
     if (!hv) {
-       (void)SvOK_off(sv);
+       SvOK_off(sv);
        return;
     }
     sv_setpv(sv, prefix ? prefix : "");
-    if (keepmain || strNE(HvNAME(hv), "main")) {
-       sv_catpv(sv,HvNAME(hv));
+    
+    name = HvNAME(hv);
+    if (!name)
+       name = "__ANON__";
+       
+    if (keepmain || strNE(name, "main")) {
+       sv_catpv(sv,name);
        sv_catpvn(sv,"::", 2);
     }
     sv_catpvn(sv,GvNAME(gv),GvNAMELEN(gv));
@@ -1145,7 +1184,7 @@ Perl_gv_check(pTHX_ HV *stash)
     for (i = 0; i <= (I32) HvMAX(stash); i++) {
        for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) {
            if (HeKEY(entry)[HeKLEN(entry)-1] == ':' &&
-               (gv = (GV*)HeVAL(entry)) && (hv = GvHV(gv)))
+               (gv = (GV*)HeVAL(entry)) && isGV(gv) && (hv = GvHV(gv)))
            {
                if (hv != PL_defstash && hv != stash)
                     gv_check(hv);              /* nested package */
@@ -1223,7 +1262,8 @@ Perl_gp_free(pTHX_ GV *gv)
     if (gp->gp_refcnt == 0) {
        if (ckWARN_d(WARN_INTERNAL))
            Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
-                       "Attempt to free unreferenced glob pointers");
+                       "Attempt to free unreferenced glob pointers"
+                        pTHX__FORMAT pTHX__VALUE);
         return;
     }
     if (gp->gp_cv) {
@@ -1236,12 +1276,18 @@ Perl_gp_free(pTHX_ GV *gv)
         return;
     }
 
-    SvREFCNT_dec(gp->gp_sv);
-    SvREFCNT_dec(gp->gp_av);
-    SvREFCNT_dec(gp->gp_hv);
-    SvREFCNT_dec(gp->gp_io);
-    SvREFCNT_dec(gp->gp_cv);
-    SvREFCNT_dec(gp->gp_form);
+    if (gp->gp_sv) SvREFCNT_dec(gp->gp_sv);
+    if (gp->gp_av) SvREFCNT_dec(gp->gp_av);
+    if (gp->gp_hv) {
+        if (PL_stashcache && HvNAME(gp->gp_hv))
+             hv_delete(PL_stashcache,
+                       HvNAME(gp->gp_hv), strlen(HvNAME(gp->gp_hv)),
+                       G_DISCARD);
+        SvREFCNT_dec(gp->gp_hv);
+    }
+    if (gp->gp_io)   SvREFCNT_dec(gp->gp_io);
+    if (gp->gp_cv)   SvREFCNT_dec(gp->gp_cv);
+    if (gp->gp_form) SvREFCNT_dec(gp->gp_form);
 
     Safefree(gp);
     GvGP(gv) = 0;
@@ -1337,7 +1383,8 @@ Perl_Gv_AMupdate(pTHX_ HV *stash)
                /* GvSV contains the name of the method. */
                GV *ngv = Nullgv;
                
-               DEBUG_o( Perl_deb(aTHX_ "Resolving method `%.256"SVf"' 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(stash)) );
                if (!SvPOK(GvSV(gv))
                    || !(ngv = gv_fetchmethod_autoload(stash, SvPVX(GvSV(gv)),
@@ -1346,7 +1393,8 @@ Perl_Gv_AMupdate(pTHX_ HV *stash)
                    /* Can be an import stub (created by `can'). */
                    SV *gvsv = GvSV(gv);
                    const char *name = SvPOK(gvsv) ?  SvPVX(gvsv) : "???";
-                   Perl_croak(aTHX_ "%s method `%.256s' overloading `%s' in package `%.256s'",
+                   Perl_croak(aTHX_ "%s method `%.256s' overloading `%s' "\
+                               "in package `%.256s'",
                               (GvCVGEN(gv) ? "Stub found while resolving"
                                : "Can't resolve"),
                               name, cp, HvNAME(stash));
@@ -1390,7 +1438,7 @@ Perl_gv_handler(pTHX_ HV *stash, I32 id)
     AMT *amtp;
     CV *ret;
 
-    if (!stash)
+    if (!stash || !HvNAME(stash))
         return Nullcv;
     mg = mg_find((SV*)stash, PERL_MAGIC_overload_table);
     if (!mg) {
@@ -1822,7 +1870,6 @@ Perl_is_gv_magical(pTHX_ char *name, STRLEN len, U32 flags)
     case '!':
     case '-':
     case '#':
-    case '*':
     case '[':
     case '^':
     case '~':