diff options
author | Rafael Garcia-Suarez <rgarciasuarez@gmail.com> | 2007-06-29 09:00:32 +0000 |
---|---|---|
committer | Rafael Garcia-Suarez <rgarciasuarez@gmail.com> | 2007-06-29 09:00:32 +0000 |
commit | 0fa56319bf436f5bc52860b8491e91269fb41056 (patch) | |
tree | 6ce2bf3a62522458b139993cedfffb934e42daf3 | |
parent | fdef73f9d3c637571d3ab9a9d73990f87b1ad2d9 (diff) | |
download | perl-0fa56319bf436f5bc52860b8491e91269fb41056.tar.gz |
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
-rw-r--r-- | embed.fnc | 1 | ||||
-rw-r--r-- | embed.h | 2 | ||||
-rw-r--r-- | hv.c | 28 | ||||
-rw-r--r-- | mg.c | 20 | ||||
-rw-r--r-- | mro.c | 6 | ||||
-rw-r--r-- | perl.h | 2 | ||||
-rw-r--r-- | proto.h | 4 | ||||
-rw-r--r-- | sv.c | 1 | ||||
-rw-r--r-- | t/mro/basic.t | 43 |
9 files changed, 7 insertions, 100 deletions
@@ -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 @@ -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) @@ -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) { @@ -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) { @@ -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"); @@ -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 @@ -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); @@ -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 be7e3ddec0..e6792751ee 100644 --- 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/])); -} |