Fix corelist.pl after the reorganisation of the

[perl5.git] / gv.c

diff --git a/gv.c b/gv.c
index fc61e8c..9751afa 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -360,7 +360,7 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
 
     DEBUG_o( Perl_deb(aTHX_ "Looking for method %s in package %s\n",name,hvname) );
 
-    topgen_cmp = HvMROMETA(stash)->sub_generation + PL_sub_generation;
+    topgen_cmp = HvMROMETA(stash)->cache_gen + PL_sub_generation;
 
     /* check locally for a real method or a cache entry */
     gvp = (GV**)hv_fetch(stash, name, len, create);
@@ -405,17 +405,7 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
         assert(linear_sv);
         cstash = gv_stashsv(linear_sv, 0);
 
-        /* mg.c:Perl_magic_setisa sets the fake flag on packages it had
-           to create that the user did not.  The "package" statement
-           clears it.  We also check if there's anything in the symbol
-           table at all, which would indicate a previously "fake" package
-           where someone adding things via $Foo::Bar = 1 without ever
-           using a "package" statement.
-           This was all neccesary because magic_setisa needs a place to
-           keep isarev information on packages that aren't yet defined,
-           yet we still need to issue this warning when appropriate.
-        */
-        if (!cstash || (HvMROMETA(cstash)->fake && !HvFILL(cstash))) {
+        if (!cstash) {
             if (ckWARN(WARN_SYNTAX))
                 Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Can't locate package %"SVf" for @%s::ISA",
                     SVfARG(linear_sv), hvname);
@@ -1024,7 +1014,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
                if (*name == '!')
                    require_tie_mod(gv, "!", newSVpvs("Errno"), "TIEHASH", 1);
                else if (*name == '-' || *name == '+')
-                   require_tie_mod(gv, name, newSVpvs("Tie::Hash::NamedCapture"), "FETCH", 0);
+                   require_tie_mod(gv, name, newSVpvs("Tie::Hash::NamedCapture"), "TIEHASH", 0);
            }
        }
        return gv;
@@ -1137,14 +1127,14 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
                break;
             case '\015':        /* $^MATCH */
                 if (strEQ(name2, "ATCH"))
-                   goto ro_magicalize;
+                   goto magicalize;
            case '\017':        /* $^OPEN */
                if (strEQ(name2, "PEN"))
                    goto magicalize;
                break;
            case '\020':        /* $^PREMATCH  $^POSTMATCH */
                if (strEQ(name2, "REMATCH") || strEQ(name2, "OSTMATCH"))
-                   goto ro_magicalize;  
+                   goto magicalize;  
            case '\024':        /* ${^TAINT} */
                if (strEQ(name2, "AINT"))
                    goto ro_magicalize;
@@ -1171,14 +1161,14 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
            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 */
+               /* Ensures that we have an all-digit variable, ${"1foo"} fails
+                  this test  */
+               /* This snippet is taken from is_gv_magical */
                const char *end = name + len;
                while (--end > name) {
-                   if (!isDIGIT(*end)) return gv;
+                   if (!isDIGIT(*end)) return gv;
                }
-               goto ro_magicalize;
+               goto magicalize;
            }
            }
        }
@@ -1197,7 +1187,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
                sv_type == SVt_PVIO
                ) { break; }
            PL_sawampersand = TRUE;
-           goto ro_magicalize;
+           goto magicalize;
 
        case ':':
            sv_setpv(GvSVn(gv),PL_chopset);
@@ -1234,7 +1224,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
             SvREADONLY_on(av);
 
             if (sv_type == SVt_PVHV || sv_type == SVt_PVGV)
-                require_tie_mod(gv, name, newSVpvs("Tie::Hash::NamedCapture"), "FETCH", 0);
+                require_tie_mod(gv, name, newSVpvs("Tie::Hash::NamedCapture"), "TIEHASH", 0);
 
             break;
        }
@@ -1255,6 +1245,9 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
            }
            goto magicalize;
        case '\023':    /* $^S */
+       ro_magicalize:
+           SvREADONLY_on(GvSVn(gv));
+           /* FALL THROUGH */
        case '1':
        case '2':
        case '3':
@@ -1264,9 +1257,6 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
        case '7':
        case '8':
        case '9':
-       ro_magicalize:
-           SvREADONLY_on(GvSVn(gv));
-           /* FALL THROUGH */
        case '[':
        case '^':
        case '~':
@@ -1445,15 +1435,6 @@ Perl_gp_ref(pTHX_ GP *gp)
            gp->gp_cv = NULL;
            gp->gp_cvgen = 0;
        }
-        /* XXX if anyone finds a method cache regression with
-           the "mro" stuff, turning this else block back on
-           is probably the first place to look --blblack
-        */
-        /*
-        else {
-            PL_sub_generation++;
-        }
-        */
     }
     return gp;
 }
@@ -1473,10 +1454,6 @@ Perl_gp_free(pTHX_ GV *gv)
                         pTHX__FORMAT pTHX__VALUE);
         return;
     }
-    if (gp->gp_cv) {
-       /* Deleting the name of a subroutine invalidates method cache */
-       PL_sub_generation++;
-    }
     if (--gp->gp_refcnt > 0) {
        if (gp->gp_egv == gv)
            gp->gp_egv = 0;
@@ -1532,9 +1509,10 @@ Perl_Gv_AMupdate(pTHX_ HV *stash)
   dVAR;
   MAGIC* const mg = mg_find((SV*)stash, PERL_MAGIC_overload_table);
   AMT amt;
+  const struct mro_meta* stash_meta = HvMROMETA(stash);
   U32 newgen;
 
-  newgen = PL_sub_generation + HvMROMETA(stash)->sub_generation;
+  newgen = PL_sub_generation + stash_meta->pkg_gen + stash_meta->cache_gen;
   if (mg) {
       const AMT * const amtp = (AMT*)mg->mg_ptr;
       if (amtp->was_ok_am == PL_amagic_generation
@@ -1661,11 +1639,13 @@ Perl_gv_handler(pTHX_ HV *stash, I32 id)
     MAGIC *mg;
     AMT *amtp;
     U32 newgen;
+    struct mro_meta* stash_meta;
 
     if (!stash || !HvNAME_get(stash))
         return NULL;
 
-    newgen = PL_sub_generation + HvMROMETA(stash)->sub_generation;
+    stash_meta = HvMROMETA(stash);
+    newgen = PL_sub_generation + stash_meta->pkg_gen + stash_meta->cache_gen;
 
     mg = mg_find((SV*)stash, PERL_MAGIC_overload_table);
     if (!mg) {