Revert #19498 since it broke threaded builds.

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

diff --git a/gv.c b/gv.c
index 08dd7c3..95d4d36 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -1,6 +1,7 @@
 /*    gv.c
  *
- *    Copyright (c) 1991-2002, Larry Wall
+ *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
+ *    2000, 2001, 2002, 2003, 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.
@@ -193,6 +194,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));
@@ -687,8 +692,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 */
 
@@ -764,8 +767,10 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type)
                  : sv_type == SVt_PVAV ? "@"
                  : sv_type == SVt_PVHV ? "%"
                  : ""), name));
+           stash = GvHV(gv_fetchpv("<none>::", GV_ADDMULTI, SVt_PVHV));
        }
-       return Nullgv;
+       else
+           return Nullgv;
     }
 
     if (!SvREFCNT(stash))      /* symbol table under destruction */
@@ -974,9 +979,15 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type)
             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")
-           && strNE(name, "\027IDE_SYSTEM_CALLS"))
+       if (len > 1
+           && strNE(name, "\027ARNING_BITS")
+           )
            break;
        goto magicalize;
 
@@ -1057,14 +1068,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);
        return;
     }
     sv_setpv(sv, prefix ? prefix : "");
-    if (keepmain || strNE(HvNAME(hv), "main")) {
-       sv_catpv(sv,HvNAME(hv));
+    
+    if (!HvNAME(hv))
+       name = "__ANON__";
+    else 
+       name = HvNAME(hv);
+    if (keepmain || strNE(name, "main")) {
+       sv_catpv(sv,name);
        sv_catpvn(sv,"::", 2);
     }
     sv_catpvn(sv,GvNAME(gv),GvNAMELEN(gv));
@@ -1115,6 +1132,9 @@ Perl_newIO(pTHX)
     sv_upgrade((SV *)io,SVt_PVIO);
     SvREFCNT(io) = 1;
     SvOBJECT_on(io);
+    /* Clear the stashcache because a new IO could overrule a 
+       package name */
+    hv_clear(PL_stashcache);
     iogv = gv_fetchpv("FileHandle::", FALSE, SVt_PVHV);
     /* unless exists($main::{FileHandle}) and defined(%main::FileHandle::) */
     if (!(iogv && GvHV(iogv) && HvARRAY(GvHV(iogv))))
@@ -1229,6 +1249,8 @@ Perl_gp_free(pTHX_ GV *gv)
 
     SvREFCNT_dec(gp->gp_sv);
     SvREFCNT_dec(gp->gp_av);
+    if(gp->gp_hv && HvNAME(gp->gp_hv) && PL_stashcache)
+        hv_delete(PL_stashcache, HvNAME(gp->gp_hv), strlen(HvNAME(gp->gp_hv)), G_DISCARD);
     SvREFCNT_dec(gp->gp_hv);
     SvREFCNT_dec(gp->gp_io);
     SvREFCNT_dec(gp->gp_cv);
@@ -1381,7 +1403,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) {
@@ -1793,10 +1815,13 @@ Perl_is_gv_magical(pTHX_ char *name, STRLEN len, U32 flags)
            goto yes;
        }
        break;
+    case '\025':
+        if (len > 1 && strEQ(name, "\025NICODE"))
+           goto yes;
     case '\027':   /* $^W & $^WARNING_BITS */
        if (len == 1
            || (len == 12 && strEQ(name, "\027ARNING_BITS"))
-           || (len == 17 && strEQ(name, "\027IDE_SYSTEM_CALLS")))
+           )
        {
            goto yes;
        }