Revert change #31489.

That change was adding a hook to cope with the case when one was
undef'ining *ISA globs, in order to clean up correctly. However, this
broke the case where one was assiging an array ref to @ISA, which
is likely to be more common.
Conclusion: don't undef *ISA. (or more generally don't undef globs
that contain magical variables)
p4raw-link: @31489 on //depot/perl: 5be5c7a687aa37f2ea9dec7988eb57cad1f1ec24

p4raw-id: //depot/perl@31502

diff --git a/embed.fnc b/embed.fnc
index 4acd2fd..fbd6ec7 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -455,7 +455,6 @@ p   |int    |magic_setenv   |NN SV* sv|NN MAGIC* mg
 p      |int    |magic_setfm    |NN SV* sv|NN MAGIC* mg
 dp     |int    |magic_sethint  |NN SV* sv|NN MAGIC* mg
 p      |int    |magic_setisa   |NN SV* sv|NN MAGIC* mg
-p      |int    |magic_freeisa  |NN SV* sv|NN MAGIC* mg
 p      |int    |magic_setglob  |NN SV* sv|NN MAGIC* mg
 p      |int    |magic_setmglob |NN SV* sv|NN MAGIC* mg
 p      |int    |magic_setnkeys |NN SV* sv|NN MAGIC* mg

diff --git a/embed.h b/embed.h
index 198439e..bfa2cd1 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -441,7 +441,6 @@
 #define magic_setfm            Perl_magic_setfm
 #define magic_sethint          Perl_magic_sethint
 #define magic_setisa           Perl_magic_setisa
-#define magic_freeisa          Perl_magic_freeisa
 #define magic_setglob          Perl_magic_setglob
 #define magic_setmglob         Perl_magic_setmglob
 #define magic_setnkeys         Perl_magic_setnkeys
@@ -2732,7 +2731,6 @@
 #define magic_setfm(a,b)       Perl_magic_setfm(aTHX_ a,b)
 #define magic_sethint(a,b)     Perl_magic_sethint(aTHX_ a,b)
 #define magic_setisa(a,b)      Perl_magic_setisa(aTHX_ a,b)
-#define magic_freeisa(a,b)     Perl_magic_freeisa(aTHX_ a,b)
 #define magic_setglob(a,b)     Perl_magic_setglob(aTHX_ a,b)
 #define magic_setmglob(a,b)    Perl_magic_setmglob(aTHX_ a,b)
 #define magic_setnkeys(a,b)    Perl_magic_setnkeys(aTHX_ a,b)

diff --git a/hv.c b/hv.c
index adbfbdf..cf0f3f4 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -1518,19 +1518,12 @@ Perl_hv_free_ent(pTHX_ HV *hv, register HE *entry)
 {
     dVAR;
     SV *val;
-    I32 isa_changing = 0;
 
     if (!entry)
        return;
     val = HeVAL(entry);
-
-    if(HvNAME_get(hv) && val && isGV(val)) {
-        if(GvCVu((GV*)val))
-            mro_method_changed_in(hv); /* deletion of method from stash */
-        else if(GvAV((GV*)val) && strEQ(GvNAME((GV*)val), "ISA"))
-            isa_changing = 1;
-    }
-
+    if (val && isGV(val) && GvCVu(val) && HvNAME_get(hv))
+        mro_method_changed_in(hv);     /* deletion of method from stash */
     SvREFCNT_dec(val);
     if (HeKLEN(entry) == HEf_SVKEY) {
        SvREFCNT_dec(HeKEY_sv(entry));
@@ -1541,8 +1534,6 @@ Perl_hv_free_ent(pTHX_ HV *hv, register HE *entry)
     else
        Safefree(HeKEY_hek(entry));
     del_HE(entry);
-
-    if(isa_changing) mro_isa_changed_in(hv);   /* deletion of @ISA from stash */
 }
 
 void
@@ -1853,21 +1844,8 @@ Perl_hv_undef(pTHX_ HV *hv)
     DEBUG_A(Perl_hv_assert(aTHX_ hv));
     xhv = (XPVHV*)SvANY(hv);
 
-    /* If it's a stash, undef the @ISA and call
-       mro_isa_changed_in before proceeding with
-       the rest of the destruction */
-    if ((name = HvNAME_get(hv)) && !PL_dirty) {
-        GV** gvp;
-        GV* gv;
-        AV* isa;
-
-        gvp = (GV**)hv_fetchs(hv, "ISA", FALSE);
-        gv = gvp ? *gvp : NULL;
-        isa = (gv && isGV_with_GP(gv)) ? GvAV(gv) : NULL;
-    
-        if(isa) av_undef(isa);
+    if ((name = HvNAME_get(hv)) && !PL_dirty)
         mro_isa_changed_in(hv);
-    }
 
     hfreeentries(hv);
     if (name) {

diff --git a/mg.c b/mg.c
index 06d4c8c..14b237e 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -1541,26 +1541,6 @@ Perl_magic_setisa(pTHX_ SV *sv, MAGIC *mg)
     return 0;
 }
 
-int Perl_magic_freeisa(pTHX_ SV *sv, MAGIC *mg)
-{
-    dVAR;
-    GV** gvp;
-    GV* gv;
-    AV* isa;
-
-    PERL_UNUSED_ARG(sv);
-
-    if(PL_dirty) return 0;
-
-    gvp = (GV**)hv_fetchs(GvSTASH((GV*)mg->mg_obj), "ISA", FALSE);
-    gv = gvp ? *gvp : NULL;
-    isa = (gv && isGV_with_GP(gv)) ? GvAV(gv) : NULL;
-
-    if(isa) av_undef(isa);
-
-    return 0;
-}
-
 int
 Perl_magic_setamagic(pTHX_ SV *sv, MAGIC *mg)
 {

diff --git a/mro.c b/mro.c
index 7074e7a..37573f1 100644 (file)
--- a/mro.c
+++ b/mro.c
@@ -455,10 +455,8 @@ Perl_mro_isa_changed_in(pTHX_ HV* stash)
     bool is_universal;
     struct mro_meta * meta;
 
-    const char * const stashname = stash ? HvNAME_get(stash) : NULL;
-    const STRLEN stashname_len = stash ? HvNAMELEN_get(stash) : 0;
-
-    if(!stash) return;
+    const char * const stashname = HvNAME_get(stash);
+    const STRLEN stashname_len = HvNAMELEN_get(stash);
 
     if(!stashname)
         Perl_croak(aTHX_ "Can't call mro_isa_changed_in() on anonymous symbol table");

diff --git a/perl.h b/perl.h
index d59ac35..3877de1 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -4768,7 +4768,7 @@ MGVTBL_SET(
     MEMBER_TO_FPTR(Perl_magic_setisa),
     0,
     MEMBER_TO_FPTR(Perl_magic_setisa),
-    MEMBER_TO_FPTR(Perl_magic_freeisa),
+    0,
     0,
     0,
     0

diff --git a/proto.h b/proto.h
index 5ef97ad..aa65950 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -1217,10 +1217,6 @@ PERL_CALLCONV int        Perl_magic_setisa(pTHX_ SV* sv, MAGIC* mg)
                        __attribute__nonnull__(pTHX_1)
                        __attribute__nonnull__(pTHX_2);
 
-PERL_CALLCONV int      Perl_magic_freeisa(pTHX_ SV* sv, MAGIC* mg)
-                       __attribute__nonnull__(pTHX_1)
-                       __attribute__nonnull__(pTHX_2);
-
 PERL_CALLCONV int      Perl_magic_setglob(pTHX_ SV* sv, MAGIC* mg)
                        __attribute__nonnull__(pTHX_1)
                        __attribute__nonnull__(pTHX_2);

diff --git a/sv.c b/sv.c
index 7f030e3..f503f14 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -4397,7 +4397,6 @@ Perl_sv_magicext(pTHX_ SV* sv, SV* obj, int how, const MGVTBL *vtable,
     */
     if (!obj || obj == sv ||
        how == PERL_MAGIC_arylen ||
-       how == PERL_MAGIC_isaelem ||
        how == PERL_MAGIC_qr ||
        how == PERL_MAGIC_symtab ||
        (SvTYPE(obj) == SVt_PVGV &&

diff --git a/t/mro/basic.t b/t/mro/basic.t
index be7e3dd..e679275 100644 (file)
--- a/t/mro/basic.t
+++ b/t/mro/basic.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-require q(./test.pl); plan(tests => 27);
+require q(./test.pl); plan(tests => 21);
 
 {
     package MRO_A;
@@ -147,44 +147,3 @@ is(eval { MRO_N->testfunc() }, 123);
     undef @ISACLEAR::ISA;
     ok(eq_array(mro::get_linear_isa('ISACLEAR'),[qw/ISACLEAR/]));
 }
-
-{
-    {
-        package ISACLEAR2;
-        our @ISA = qw/XX YY ZZ/;
-    }
-
-    # baseline
-    ok(eq_array(mro::get_linear_isa('ISACLEAR2'),[qw/ISACLEAR2 XX YY ZZ/]));
-
-    # delete @ISA
-    delete $ISACLEAR2::{ISA};
-    ok(eq_array(mro::get_linear_isa('ISACLEAR2'),[qw/ISACLEAR2/]));
-}
-
-# another destructive test, undef the ISA glob
-{
-    {
-        package ISACLEAR3;
-        our @ISA = qw/XX YY ZZ/;
-    }
-    # baseline
-    ok(eq_array(mro::get_linear_isa('ISACLEAR3'),[qw/ISACLEAR3 XX YY ZZ/]));
-
-    undef *ISACLEAR3::ISA;
-    ok(eq_array(mro::get_linear_isa('ISACLEAR3'),[qw/ISACLEAR3/]));
-}
-
-# This is how Class::Inner does it
-{
-    {
-        package ISACLEAR4;
-        our @ISA = qw/XX YY ZZ/;
-    }
-    # baseline
-    ok(eq_array(mro::get_linear_isa('ISACLEAR4'),[qw/ISACLEAR4 XX YY ZZ/]));
-
-    delete $ISACLEAR4::{ISA};
-    delete $::{ISACLEAR4::};
-    ok(eq_array(mro::get_linear_isa('ISACLEAR4'),[qw/ISACLEAR4/]));
-}