class.c: clean up any state if we don't finish the class

Fixes #22169

Author: tonycoz

MANIFEST

@@ -5967,6 +5967,7 @@ t/class/class.t				See if class declarations work
 t/class/construct.t			See if class constructors work
 t/class/destruct.t			See if class destruction works
 t/class/field.t				See if class field declarations work
+t/class/gh22169.t			Test defining a class that previously failed to define
 t/class/inherit.t			See if class inheritance works
 t/class/method.t			See if class method declarations work
 t/class/phasers.t			See if class phaser blocks work

class.c

@@ -805,14 +805,80 @@ Perl_class_seal_stash(pTHX_ HV *stash)
         aux->xhv_class_initfields_cv = initfields;
     }
     else {
-        /* we had errors, clean up and don't populate initfields */
+        /* we had errors, clean up */
+
+        SvREFCNT_dec(aux->xhv_class_superclass);
+        aux->xhv_class_superclass = NULL;
+
+        /* clean up adjust blocks */
+        SvREFCNT_dec(aux->xhv_class_adjust_blocks);
+        aux->xhv_class_adjust_blocks = NULL;
+
+        /* name to slot index */
+        SvREFCNT_dec(aux->xhv_class_param_map);
+        aux->xhv_class_param_map = NULL;
+
+        /* clean up the ops for defaults for fields, if any, since
+           padname_free() doesn't.
+         */
         PADNAMELIST *fieldnames = aux->xhv_class_fields;
         if (fieldnames) {
             for(SSize_t i = PadnamelistMAX(fieldnames); i >= 0 ; i--) {
                 PADNAME *pn = PadnamelistARRAY(fieldnames)[i];
                 op_free(PadnameFIELDINFO(pn)->defop);
+                PadnameFIELDINFO(pn)->defop = NULL;
             }
+            PadnamelistREFCNT_dec(fieldnames);
+            aux->xhv_class_fields = NULL;
+        }
+
+        /* TODO: cleanup DOES if added above */
+
+        /* clean up methods */
+        /* should we keep a separate list of these instead? */
+        if (hv_iterinit(stash)) {
+            HE *he;
+            while ((he = hv_iternext(stash)) != NULL) {
+                STRLEN klen;
+                const char * const kpv = HePV(he, klen);
+                SV *entry = HeVAL(he);
+                CV *cv = NULL;
+                if (SvTYPE(entry) == SVt_PVGV
+                    && (cv = GvCV((GV*)entry))
+                    && (CvIsMETHOD(cv) || memEQs(kpv, klen, "new"))) {
+                    SvREFCNT_dec(cv);
+                    GvCV_set((GV*)entry, NULL);
+                }
+                else if (SvTYPE(entry) == SVt_PVCV
+                         && (CvIsMETHOD((CV*)entry) || memEQs(kpv, klen, "new"))) {
+                    (void)hv_delete(stash, kpv, HeUTF8(he) ? -(I32)klen : (I32)klen,
+                                    G_DISCARD);
+                }
+            }
+            ++PL_sub_generation;
+        }
+
+        /* field clean up */
+        resume_compcv_final(aux->xhv_class_suspended_initfields_compcv);
+        SvREFCNT_dec(PL_compcv);
+        Safefree(aux->xhv_class_suspended_initfields_compcv);
+        aux->xhv_class_suspended_initfields_compcv = NULL;
+
+        /* remove any ISA entries */
+        SV *isaname = newSVpvf("%" HEKf "::ISA", HvNAME_HEK(stash));
+        sv_2mortal(isaname);
+        AV *isa = get_av(SvPV_nolen(isaname), (SvFLAGS(isaname) & SVf_UTF8));
+        if (isa) {
+            /* we make this read-only above since class-keyword
+               classes manage ISA themselves, the class has failed to
+               load, so we no longer manage it.
+            */
+            SvREADONLY_off((SV *)isa);
+            av_clear(isa);
         }
+        
+        /* no longer a class */
+        aux->xhv_aux_flags &= ~HvAUXf_IS_CLASS;
     }
 }
 

t/class/gh22169.t

@@ -0,0 +1,59 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    require './test.pl';
+    set_up_inc('../lib');
+    require Config;
+}
+
+use v5.36;
+use feature 'class';
+no warnings 'experimental::class';
+
+class Base {
+    method g() { "Base" }
+    ADJUST {
+        ::fail("original Base ADJUST block should not be called");
+    }
+}
+
+class Base2 {
+    method g() { "Base2" }
+}
+
+BEGIN {
+    our $saw_end;
+    eval <<'CLASS';
+class MyTest :isa(Base) {
+    field $x = "First";
+    field $w :reader;
+    ADJUST {
+        fail("ADJUST from failed class definition called");
+    }
+    method f () { $x }
+    method h() { }
+    method z() { }
+    # make sure some error above doesn't invalidate the test, this
+    BEGIN { ++$saw_end; }
+CLASS
+    ok($saw_end, "saw the end of the incomplete class definition");
+}
+
+class MyTest :isa(Base2) {
+    field $y = "Second";
+    method f() { $y }
+    ADJUST {
+        ::pass("saw adjust in replacement class definition");
+    }
+}
+
+my $z = new_ok("MyTest");
+ok(!$z->can("h"), "h() should no longer be present");
+isa_ok($z, "Base2", "check base class");
+is($z->g(), "Base2", "Base class correct via g");
+is($z->f(), "Second", "f() value");
+ok(!$z->can("w"), 'accessor for $w removed');
+
+done_testing();
+

t/lib/croak/class

@@ -145,7 +145,7 @@ no warnings 'experimental::class';
 eval "class C {";
 C->new;
 EXPECT
-Cannot create an object of incomplete class "C" at - line 5.
+Can't locate object method "new" via package "C" at - line 5.
 ########
 # NAME try to create an object of incomplete class (compile-time)
 use v5.36;