From 0bb17957e5474866af5b126cf584f2f7aa6340fb Mon Sep 17 00:00:00 2001
From: "Paul \"LeoNerd\" Evans" <leonerd@leonerd.org.uk>
Date: Wed, 30 Nov 2022 15:34:27 +0000
Subject: Refuse to create a class if its package already contains a non-empty
 @ISA array

---
 class.c | 11 +++++++++++
 1 file changed, 11 insertions(+)

(limited to 'class.c')

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;
 
-- 
cgit v1.2.1