This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Switch the core MRO code over to HvENAME
authorFather Chrysostomos <sprout@cpan.org>
Sat, 30 Oct 2010 03:45:34 +0000 (20:45 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Sat, 30 Oct 2010 04:50:24 +0000 (21:50 -0700)
This has the side-effect of fixing these one-liners:

$ perl5.13.5 -le' my $glob = \*foo::ISA; delete $::{"foo::"}; *$glob = *a'
Bus error
$ perl5.13.5 -le' my $glob = \*foo::ISA; delete $::{"foo::"}; *$glob = []'
Bus error
$ perl5.13.6 -le'sub baz; my $glob = \*foo::bar; delete $::{"foo::"}; *$glob = *baz;'
Bus error
$ perl5.13.6 -le'sub foo::bar; my $glob = \*foo::bar; delete $::{"foo::"}; *$glob = *baz;'
Bus error

In the first two cases the crash was inadvertently fixed (isn’t it
nice when that happens?) in 5.13.6 (by 6f86b615fa7), but there was
still a fatal error:
Can't call mro_isa_changed_in() on anonymous symbol table at -e line 1.

Because sv_clear calls ->DESTROY, if an object’s stash has been
detached from the symbol table, mro_get_linear_isa can be called on a
hash with no HvENAME. So HvNAME is used as a fallback for those cases.

hv.c
mg.c
mro.c
pp.c
scope.c
sv.c

diff --git a/hv.c b/hv.c
index 9035b1e..57efdaa 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -1481,7 +1481,7 @@ Perl_hv_free_ent(pTHX_ HV *hv, register HE *entry)
     if (!entry)
        return;
     val = HeVAL(entry);
-    if (val && isGV(val) && isGV_with_GP(val) && GvCVu(val) && HvNAME_get(hv))
+    if (val && isGV(val) && isGV_with_GP(val) && GvCVu(val) && HvENAME(hv))
         mro_method_changed_in(hv);     /* deletion of method from stash */
     SvREFCNT_dec(val);
     if (HeKLEN(entry) == HEf_SVKEY) {
@@ -1568,7 +1568,7 @@ Perl_hv_clear(pTHX_ HV *hv)
     HvREHASH_off(hv);
     reset:
     if (SvOOK(hv)) {
-        if(HvNAME_get(hv))
+        if(HvENAME_get(hv))
             mro_isa_changed_in(hv);
        HvEITER_set(hv, NULL);
     }
@@ -1852,11 +1852,11 @@ Perl_hv_undef(pTHX_ HV *hv)
     DEBUG_A(Perl_hv_assert(aTHX_ hv));
     xhv = (XPVHV*)SvANY(hv);
 
-    if ((name = HvNAME_get(hv)) && !PL_dirty)
+    if ((name = HvENAME_get(hv)) && !PL_dirty)
         mro_isa_changed_in(hv);
 
     hfreeentries(hv);
-    if (name) {
+    if (name || (name = HvNAME(hv))) {
         if (PL_stashcache)
            (void)hv_delete(PL_stashcache, name, HvNAMELEN_get(hv), G_DISCARD);
        hv_name_set(hv, NULL, 0, 0);
diff --git a/mg.c b/mg.c
index 03ff000..4a1a72b 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -1630,7 +1630,9 @@ Perl_magic_clearisa(pTHX_ SV *sv, MAGIC *mg)
             : (const GV *)mg_find(mg->mg_obj, PERL_MAGIC_isa)->mg_obj
     );
 
-    if (stash)
+    /* The stash may have been detached from the symbol table, so check its
+       name before doing anything. */
+    if (stash && HvENAME_get(stash))
        mro_isa_changed_in(stash);
 
     return 0;
diff --git a/mro.c b/mro.c
index a584686..ca38a76 100644 (file)
--- a/mro.c
+++ b/mro.c
@@ -215,7 +215,11 @@ S_mro_get_linear_isa_dfs(pTHX_ HV *stash, U32 level)
     PERL_ARGS_ASSERT_MRO_GET_LINEAR_ISA_DFS;
     assert(HvAUX(stash));
 
-    stashhek = HvNAME_HEK(stash);
+    stashhek
+     = HvAUX(stash)->xhv_name && HvENAME_HEK_NN(stash)
+        ? HvENAME_HEK_NN(stash)
+        : HvNAME_HEK(stash);
+
     if (!stashhek)
       Perl_croak(aTHX_ "Can't linearize anonymous symbol table");
 
@@ -438,8 +442,8 @@ Perl_mro_isa_changed_in3(pTHX_ HV* stash, const char *stashname,
     struct mro_meta * meta = NULL;
 
     if(!stashname && stash) {
-        stashname = HvNAME_get(stash);
-        stashname_len = HvNAMELEN_get(stash);
+        stashname = HvENAME_get(stash);
+        stashname_len = HvENAMELEN_get(stash);
     }
     else if(!stash)
         stash = gv_stashpvn(stashname, stashname_len, 0 /* don't add */);
@@ -692,7 +696,7 @@ Perl_mro_package_moved(pTHX_ HV * const stash, HV * const oldstash,
                            stashentry && *stashentry
                         && (substash = GvHV(*stashentry))
                        )
-                    || (oldsubstash && HvNAME(oldsubstash))
+                    || (oldsubstash && HvENAME_get(oldsubstash))
                    )
                    {
                        /* Add :: and the key (minus the trailing ::)
@@ -782,7 +786,7 @@ Perl_mro_package_moved(pTHX_ HV * const stash, HV * const oldstash,
     }
 
    set_names:
-    if(oldstash && HvNAME(oldstash)) {
+    if(oldstash && HvENAME_get(oldstash)) {
        if(PL_stashcache)
            (void)
             hv_delete(PL_stashcache, newname, newname_len, G_DISCARD);
@@ -824,8 +828,8 @@ via, C<mro::method_changed_in(classname)>.
 void
 Perl_mro_method_changed_in(pTHX_ HV *stash)
 {
-    const char * const stashname = HvNAME_get(stash);
-    const STRLEN stashname_len = HvNAMELEN_get(stash);
+    const char * const stashname = HvENAME_get(stash);
+    const STRLEN stashname_len = HvENAMELEN_get(stash);
 
     SV ** const svp = hv_fetch(PL_isarev, stashname, stashname_len, 0);
     HV * const isarev = svp ? MUTABLE_HV(*svp) : NULL;
diff --git a/pp.c b/pp.c
index c99d697..45f536e 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -854,11 +854,11 @@ PP(pp_undef)
             HV *stash;
 
             /* undef *Foo:: */
-            if((stash = GvHV((const GV *)sv)) && HvNAME_get(stash))
+            if((stash = GvHV((const GV *)sv)) && HvENAME_get(stash))
                 mro_isa_changed_in(stash);
             /* undef *Pkg::meth_name ... */
             else if(GvCVu((const GV *)sv) && (stash = GvSTASH((const GV *)sv))
-                   && HvNAME_get(stash))
+                   && HvENAME_get(stash))
                 mro_method_changed_in(stash);
 
            gp_free(MUTABLE_GV(sv));
diff --git a/scope.c b/scope.c
index eb464f9..4a1b399 100644 (file)
--- a/scope.c
+++ b/scope.c
@@ -859,7 +859,7 @@ Perl_leave_scope(pTHX_ I32 base)
            if (SSPOPINT)
                SvFAKE_on(gv);
             /* putting a method back into circulation ("local")*/
-           if (GvCVu(gv) && (hv=GvSTASH(gv)) && HvNAME_get(hv))
+           if (GvCVu(gv) && (hv=GvSTASH(gv)) && HvENAME_get(hv))
                 mro_method_changed_in(hv);
            SvREFCNT_dec(gv);
            break;
diff --git a/sv.c b/sv.c
index 3c13a46..6173b0a 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -3607,13 +3607,18 @@ S_glob_assign_glob(pTHX_ SV *const dstr, SV *const sstr, const int dtype)
         }
         /* If source has a real method, then a method is
            going to change */
-        else if(GvCV((const GV *)sstr)) {
+        else if(
+         GvCV((const GV *)sstr) && GvSTASH(dstr) && HvENAME(GvSTASH(dstr))
+        ) {
             mro_changes = 1;
         }
     }
 
     /* If dest already had a real method, that's a change as well */
-    if(!mro_changes && GvGP(MUTABLE_GV(dstr)) && GvCVu((const GV *)dstr)) {
+    if(
+        !mro_changes && GvGP(MUTABLE_GV(dstr)) && GvCVu((const GV *)dstr)
+     && GvSTASH(dstr) && HvENAME(GvSTASH(dstr))
+    ) {
         mro_changes = 1;
     }
 
@@ -3621,7 +3626,12 @@ S_glob_assign_glob(pTHX_ SV *const dstr, SV *const sstr, const int dtype)
        glob to begin with. */
     if(dtype == SVt_PVGV) {
         const char * const name = GvNAME((const GV *)dstr);
-        if(strEQ(name,"ISA"))
+        if(
+            strEQ(name,"ISA")
+         /* The stash may have been detached from the symbol table, so
+            check its name. */
+         && GvSTASH(dstr) && HvENAME(GvSTASH(dstr))
+        )
             mro_changes = 2;
         else {
             const STRLEN len = GvNAMELEN(dstr);
@@ -3781,7 +3791,12 @@ S_glob_assign_ref(pTHX_ SV *const dstr, SV *const sstr)
                );
            }
        }
-       else if (stype == SVt_PVAV && strEQ(GvNAME((GV*)dstr), "ISA")) {
+       else if (
+           stype == SVt_PVAV && strEQ(GvNAME((GV*)dstr), "ISA")
+        /* The stash may have been detached from the symbol table, so
+           check its name before doing anything. */
+        && GvSTASH(dstr) && HvENAME(GvSTASH(dstr))
+       ) {
            sv_magic(sref, dstr, PERL_MAGIC_isa, NULL, 0);
            mro_isa_changed_in(GvSTASH(dstr));
        }
@@ -5991,7 +6006,7 @@ Perl_sv_clear(pTHX_ SV *const orig_sv)
        case SVt_PVGV:
            if (isGV_with_GP(sv)) {
                if(GvCVu((const GV *)sv) && (stash = GvSTASH(MUTABLE_GV(sv)))
-                  && HvNAME_get(stash))
+                  && HvENAME_get(stash))
                    mro_method_changed_in(stash);
                gp_free(MUTABLE_GV(sv));
                if (GvNAME_HEK(sv))