Prevent loop exits from unwinding the context/scope stacks beyond a call_sv for smartmatch subs and class constructors

class.c

@@ -175,6 +175,8 @@ XS(injected_constructor)
 
     SV *self = sv_2mortal(newRV_noinc(instance));
 
+    PUSHSTACKi(PERLSI_CONSTRUCTOR);
+
     assert(aux->xhv_class_initfields_cv);
     {
         ENTER;
@@ -221,6 +223,9 @@ XS(injected_constructor)
         }
     }
 
+    POPSTACK;
+    SPAGAIN;
+
     if(params && hv_iterinit(params) > 0) {
         /* TODO: consider sorting these into a canonical order, but that's awkward */
         HE *he = hv_iternext(params);

cop.h

@@ -1258,6 +1258,8 @@ struct context {
 #define PERLSI_REQUIRE		9
 #define PERLSI_MULTICALL       10
 #define PERLSI_REGCOMP         11
+#define PERLSI_SMARTMATCH      12
+#define PERLSI_CONSTRUCTOR     13
 
 struct stackinfo {
     AV *		si_stack;	/* stack for current runlevel */

deb.c

@@ -236,7 +236,10 @@ static const char * const si_names[] = {
     "WARNHOOK",
     "DIEHOOK",
     "REQUIRE",
-    "MULTICALL"
+    "MULTICALL",
+    "REGCOMP",
+    "SMARTMATCH",
+    "CONSTRUCTOR"
 };
 #endif
 

pod/perldelta.pod

@@ -390,6 +390,17 @@ Discussed in [GH #23171].
 Ensure cloning the save stack for fork emulation doesn't duplicate
 freeing the RExC state. [GH #23022]
 
+=item *
+
+Smartmatch against a code reference that uses a loop exit such as
+C<last> would crash perl.  [GH #16608]
+
+=item *
+
+Class initializers and C<ADJUST> blocks, per L<perlclass>, that
+called C<last> or other loop exits would crash perl.  Same cause as
+for [GH #16608].
+
 =back
 
 =head1 Known Problems

pp_ctl.c

@@ -5941,6 +5941,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other, const bool copied)
             DEBUG_M(Perl_deb(aTHX_ "    applying rule Hash-CodeRef\n"));
             if (numkeys == 0)
                 goto ret_yes;
+            push_stackinfo(PERLSI_SMARTMATCH, 1);
             while ( (he = hv_iternext(hv)) ) {
                 DEBUG_M(Perl_deb(aTHX_ "        testing hash key...\n"));
                 ENTER_with_name("smartmatch_hash_key_test");
@@ -5953,6 +5954,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other, const bool copied)
                 FREETMPS;
                 LEAVE_with_name("smartmatch_hash_key_test");
             }
+            pop_stackinfo();
             if (andedresults)
                 goto ret_yes;
             else
@@ -5967,6 +5969,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other, const bool copied)
             DEBUG_M(Perl_deb(aTHX_ "    applying rule Array-CodeRef\n"));
             if (len == 0)
                 goto ret_yes;
+            push_stackinfo(PERLSI_SMARTMATCH, 1);
             for (i = 0; i < len; ++i) {
                 SV * const * const svp = av_fetch(av, i, FALSE);
                 DEBUG_M(Perl_deb(aTHX_ "        testing array element...\n"));
@@ -5981,6 +5984,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other, const bool copied)
                 FREETMPS;
                 LEAVE_with_name("smartmatch_array_elem_test");
             }
+            pop_stackinfo();
             if (andedresults)
                 goto ret_yes;
             else
@@ -5989,12 +5993,14 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other, const bool copied)
         else {
           sm_any_sub:
             DEBUG_M(Perl_deb(aTHX_ "    applying rule Any-CodeRef\n"));
+            push_stackinfo(PERLSI_SMARTMATCH, 1);
             ENTER_with_name("smartmatch_coderef");
             PUSHMARK(PL_stack_sp);
             rpp_xpush_1(d);
             (void)call_sv(e, G_SCALAR);
             LEAVE_with_name("smartmatch_coderef");
             SV *retsv = *PL_stack_sp--;
+            pop_stackinfo();
             rpp_replace_2_1(retsv);
 #ifdef PERL_RC_STACK
             SvREFCNT_dec(retsv);

t/lib/croak/class

@@ -185,3 +185,31 @@ class XXX {
 }
 EXPECT
 Cannot apply a :writer attribute to a non-scalar field at - line 6.
+########
+use v5.36;
+use feature 'class';
+no warnings 'experimental::class';
+sub f { last }
+class X {
+    field $x = ::f();
+}
+# two warnings since we exit the initfields cv and f()
+X->new for 0;
+EXPECT
+Exiting subroutine via last at - line 4.
+Exiting subroutine via last at - line 4.
+Can't "last" outside a loop block at - line 4.
+########
+use v5.36;
+use feature 'class';
+no warnings 'experimental::class';
+class X {
+    field $x;
+    ADJUST {
+        last;
+    }
+}
+X->new for 0;
+EXPECT
+Exiting subroutine via last at - line 7.
+Can't "last" outside a loop block at - line 7.

t/lib/croak/pp_ctl

@@ -57,3 +57,71 @@ die;
 EXPECT
 Unmatched ) in regex; marked by <-- HERE in m/_) <-- HERE / at (eval 1) line 1.
 	...propagated at - line 2.
+########
+# NAME last from smartmatch CV
+0 ~~ sub {last} for 0
+EXPECT
+Can't "last" outside a loop block at - line 1.
+########
+# NAME redo from smartmatch CV
+0 ~~ sub {redo} for 0
+EXPECT
+Can't "redo" outside a loop block at - line 1.
+########
+# NAME next from smartmatch CV
+0 ~~ sub {next} for 0
+EXPECT
+Can't "next" outside a loop block at - line 1.
+########
+# NAME goto loop label from smartmatch CV
+FOO: 0~~sub{goto FOO} for 0
+EXPECT
+Can't find label FOO at - line 1.
+########
+# NAME last from smartmatch CV against array
+my @x = (0);
+@x ~~ sub {last} for 0
+EXPECT
+Can't "last" outside a loop block at - line 2.
+########
+# NAME redo from smartmatch CV against array
+my @x = (0);
+@x ~~ sub {redo} for 0
+EXPECT
+Can't "redo" outside a loop block at - line 2.
+########
+# NAME next from smartmatch CV against array
+my @x = (0);
+@x ~~ sub {next} for 0
+EXPECT
+Can't "next" outside a loop block at - line 2.
+########
+# NAME goto loop label from smartmatch CV against array
+my @x = (0);
+FOO:@x ~~sub{goto FOO} for 0
+EXPECT
+Can't find label FOO at - line 2.
+########
+# NAME last from smartmatch CV against hash
+my %x = qw(a b);
+%x ~~ sub {last} for 0
+EXPECT
+Can't "last" outside a loop block at - line 2.
+########
+# NAME redo from smartmatch CV against hash
+my %x = qw(a b);
+%x ~~ sub {redo} for 0
+EXPECT
+Can't "redo" outside a loop block at - line 2.
+########
+# NAME next from smartmatch CV against hash
+my %x = qw(a b);
+%x ~~ sub {next} for 0
+EXPECT
+Can't "next" outside a loop block at - line 2.
+########
+# NAME goto loop label from smartmatch CV against hash
+my %x = qw(a b);
+FOO:%x ~~sub{goto FOO} for 0
+EXPECT
+Can't find label FOO at - line 2.