summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--class.c11
-rw-r--r--pod/perldiag.pod6
-rw-r--r--t/lib/croak/class7
3 files changed, 24 insertions, 0 deletions
diff --git a/class.c b/class.c
index 13cb0bff42..3d088c05fb 100644
--- a/class.c
+++ b/class.c
@@ -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.