summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRafael Garcia-Suarez <rgarciasuarez@gmail.com>2007-06-29 09:00:32 +0000
committerRafael Garcia-Suarez <rgarciasuarez@gmail.com>2007-06-29 09:00:32 +0000
commit0fa56319bf436f5bc52860b8491e91269fb41056 (patch)
tree6ce2bf3a62522458b139993cedfffb934e42daf3
parentfdef73f9d3c637571d3ab9a9d73990f87b1ad2d9 (diff)
downloadperl-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.fnc1
-rw-r--r--embed.h2
-rw-r--r--hv.c28
-rw-r--r--mg.c20
-rw-r--r--mro.c6
-rw-r--r--perl.h2
-rw-r--r--proto.h4
-rw-r--r--sv.c1
-rw-r--r--t/mro/basic.t43
9 files changed, 7 insertions, 100 deletions
diff --git a/embed.fnc b/embed.fnc
index 4acd2fd45a..fbd6ec735a 100644
--- 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 198439e8c0..bfa2cd1739 100644
--- 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 adbfbdf0e0..cf0f3f4524 100644
--- 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 06d4c8c97a..14b237e44d 100644
--- 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 7074e7ab72..37573f1eec 100644
--- 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 d59ac351c5..3877de1070 100644
--- 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 5ef97ad23d..aa659507e6 100644
--- 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 7f030e3f08..f503f140a1 100644
--- 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 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/]));
-}