diff options
| -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 | 46 |
9 files changed, 103 insertions, 7 deletions
@@ -455,6 +455,7 @@ 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,6 +441,7 @@ #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 @@ -2731,6 +2732,7 @@ #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,12 +1518,19 @@ Perl_hv_free_ent(pTHX_ HV *hv, register HE *entry) { dVAR; SV *val; + I32 isa_changing = 0; if (!entry) return; val = HeVAL(entry); - if (val && isGV(val) && GvCVu(val) && HvNAME_get(hv)) - mro_method_changed_in(hv); /* deletion of method from stash */ + + 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; + } + SvREFCNT_dec(val); if (HeKLEN(entry) == HEf_SVKEY) { SvREFCNT_dec(HeKEY_sv(entry)); @@ -1534,6 +1541,8 @@ 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 @@ -1844,8 +1853,21 @@ 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 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); mro_isa_changed_in(hv); + } hfreeentries(hv); if (name) { @@ -1541,6 +1541,26 @@ 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) { @@ -448,8 +448,10 @@ Perl_mro_isa_changed_in(pTHX_ HV* stash) bool is_universal; struct mro_meta * meta; - const char * const stashname = HvNAME_get(stash); - const STRLEN stashname_len = HvNAMELEN_get(stash); + const char * const stashname = stash ? HvNAME_get(stash) : NULL; + const STRLEN stashname_len = stash ? HvNAMELEN_get(stash) : 0; + + if(!stash) return; 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), - 0, + MEMBER_TO_FPTR(Perl_magic_freeisa), 0, 0, 0 @@ -1217,6 +1217,10 @@ 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,6 +4397,7 @@ 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 332782e02b..be7e3ddec0 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 => 21); +require q(./test.pl); plan(tests => 27); { package MRO_A; @@ -127,6 +127,8 @@ is(eval { MRO_N->testfunc() }, 123); } # clearing @ISA in different ways +# some are destructive to the package, hence the new +# package name each time { no warnings 'uninitialized'; { @@ -141,6 +143,48 @@ is(eval { MRO_N->testfunc() }, 123); $ISACLEAR::ISA[1] = undef; ok(eq_array(mro::get_linear_isa('ISACLEAR'),[qw/ISACLEAR XX main ZZ/])); + # undef the array itself 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/])); +} |