diff options
author | Paul "LeoNerd" Evans <leonerd@leonerd.org.uk> | 2022-11-30 15:34:27 +0000 |
---|---|---|
committer | Paul "LeoNerd" Evans <leonerd@leonerd.org.uk> | 2023-02-10 14:37:25 +0000 |
commit | 0bb17957e5474866af5b126cf584f2f7aa6340fb (patch) | |
tree | 7d9a4dce57513e3d93cb161f3e8fd424d6d88990 | |
parent | e51627afd15d704290c8201fdfc02bd7951564f3 (diff) | |
download | perl-0bb17957e5474866af5b126cf584f2f7aa6340fb.tar.gz |
Refuse to create a class if its package already contains a non-empty @ISA array
-rw-r--r-- | class.c | 11 | ||||
-rw-r--r-- | pod/perldiag.pod | 6 | ||||
-rw-r--r-- | t/lib/croak/class | 7 |
3 files changed, 24 insertions, 0 deletions
@@ -258,6 +258,17 @@ Perl_class_setup_stash(pTHX_ HV *stash) HvNAMEfARG(stash)); } + { + SV *isaname = newSVpvf("%" HEKf "::ISA", HvNAME_HEK(stash)); + sv_2mortal(isaname); + + AV *isa = get_av(SvPV_nolen(isaname), (SvFLAGS(isaname) & SVf_UTF8)); + + if(isa && av_count(isa) > 0) + croak("Cannot create class %" HEKf " as it already has a non-empty @ISA", + HvNAME_HEK(stash)); + } + char *classname = HvNAME(stash); U32 nameflags = HvNAMEUTF8(stash) ? SVf_UTF8 : 0; diff --git a/pod/perldiag.pod b/pod/perldiag.pod index c0ca5cc007..933e3390f3 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -713,6 +713,12 @@ no legal conversion from that type of reference to a typeglob. (P) Perl detected an attempt to copy a value to an internal type that cannot be directly assigned to. +=item Cannot create class %s as it already has a non-empty @ISA + +(F) An attempt was made to create a class out of a package that already has +an C<@ISA> array, and the array is not empty. This is not permitted, as it +would lead to a class with inconsistent inheritance. + =item Cannot find encoding "%s" (S io) You tried to apply an encoding that did not exist to a filehandle, diff --git a/t/lib/croak/class b/t/lib/croak/class index 0b70d6435c..a2c112ff95 100644 --- a/t/lib/croak/class +++ b/t/lib/croak/class @@ -80,3 +80,10 @@ class XXX {} push @XXX::ISA, q(Another); EXPECT Modification of a read-only value attempted at - line 4. +######## +no warnings 'experimental::class'; +use feature 'class'; +BEGIN { push @XXX::ISA, q(Another); } +class XXX {} +EXPECT +Cannot create class XXX as it already has a non-empty @ISA at - line 4. |