diff options
| -rw-r--r-- | class.c | 14 | ||||
| -rw-r--r-- | gv.c | 8 | ||||
| -rw-r--r-- | t/class/inherit.t | 2 | ||||
| -rw-r--r-- | t/lib/croak/class | 7 |
4 files changed, 28 insertions, 3 deletions
@@ -379,14 +379,22 @@ apply_class_attribute_isa(pTHX_ HV *stash, SV *value) * You'd think that GvAV() of hv_fetchs() would do it, but no, because it * won't lazily create a proper (magical) GV if one didn't already exist. */ - AV *isa; { SV *isaname = newSVpvf("%" HEKf "::ISA", HvNAME_HEK(stash)); sv_2mortal(isaname); - isa = get_av(SvPV_nolen(isaname), GV_ADD | (SvFLAGS(isaname) & SVf_UTF8)); + AV *isa = get_av(SvPV_nolen(isaname), GV_ADD | (SvFLAGS(isaname) & SVf_UTF8)); + + ENTER; + + /* Temporarily remove the SVf_READONLY flag */ + SAVESETSVFLAGS((SV *)isa, SVf_READONLY|SVf_PROTECT, SVf_READONLY|SVf_PROTECT); + SvREADONLY_off((SV *)isa); + + av_push(isa, newSVsv(value)); + + LEAVE; } - av_push(isa, newSVsv(value)); aux->xhv_class_superclass = (HV *)SvREFCNT_inc(superstash); @@ -1763,6 +1763,14 @@ S_gv_magicalize_isa(pTHX_ GV *gv) GvMULTI_on(gv); sv_magic(MUTABLE_SV(av), MUTABLE_SV(gv), PERL_MAGIC_isa, NULL, 0); + + if(HvSTASH_IS_CLASS(GvSTASH(gv))) { + /* Don't permit modification of @ISA outside of the class management + * code. This is temporarily undone by class.c when fiddling with the + * array, so it knows it can be done safely. + */ + SvREADONLY_on((SV *)av); + } } /* This function grabs name and tries to split a stash and glob diff --git a/t/class/inherit.t b/t/class/inherit.t index d9972f5161..dfacf7a2a8 100644 --- a/t/class/inherit.t +++ b/t/class/inherit.t @@ -28,6 +28,8 @@ no warnings 'experimental::class'; ok($obj isa Test1B, 'Object is its own class'); ok($obj isa Test1A, 'Object is also its base class'); + ok(eq_array(\@Test1B::ISA, ["Test1A"]), '@Test1B::ISA is set correctly'); + is($obj->y, "derived class", 'Object has derived class field'); can_ok($obj, "x"); diff --git a/t/lib/croak/class b/t/lib/croak/class index e512282588..0b70d6435c 100644 --- a/t/lib/croak/class +++ b/t/lib/croak/class @@ -73,3 +73,10 @@ class XXX {} class XXX {} EXPECT Cannot reopen existing class "XXX" at - line 4. +######## +no warnings 'experimental::class'; +use feature 'class'; +class XXX {} +push @XXX::ISA, q(Another); +EXPECT +Modification of a read-only value attempted at - line 4. |