From e51627afd15d704290c8201fdfc02bd7951564f3 Mon Sep 17 00:00:00 2001
From: "Paul \"LeoNerd\" Evans" <leonerd@leonerd.org.uk>
Date: Mon, 14 Nov 2022 16:44:32 +0000
Subject: [PATCH] Make @ISA a readonly array on class stashes so user code
 can't fiddle with it and break stuff

---
 class.c           | 14 +++++++++++---
 gv.c              |  8 ++++++++
 t/class/inherit.t |  2 ++
 t/lib/croak/class |  7 +++++++
 4 files changed, 28 insertions(+), 3 deletions(-)

diff --git a/class.c b/class.c
index 70027c432874..13cb0bff4241 100644
--- a/class.c
+++ b/class.c
@@ -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);
 
diff --git a/gv.c b/gv.c
index f42ac4a3aec0..0ce2a2ac271c 100644
--- a/gv.c
+++ b/gv.c
@@ -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 d9972f516148..dfacf7a2a8e0 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 e512282588b6..0b70d6435c2a 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.