From 6646c81aeafb297cc7deea86477d4e144a8f0321 Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Wed, 9 Apr 2025 10:36:29 +1000 Subject: [PATCH 1/4] PERLSI_REGCOMP: add debugging string --- deb.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/deb.c b/deb.c index 691fced7efec..a5ad066df462 100644 --- a/deb.c +++ b/deb.c @@ -236,7 +236,8 @@ static const char * const si_names[] = { "WARNHOOK", "DIEHOOK", "REQUIRE", - "MULTICALL" + "MULTICALL", + "REGCOMP" }; #endif From 0a0576557692a14cdd5a5fd38bc27dd174c5f043 Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Wed, 9 Apr 2025 11:36:55 +1000 Subject: [PATCH 2/4] smartmatch: fail to find the loop instead of crashing dopoptoloop() or dopoptolabel() would find a loop outside the sub called from call_sv() and rewind the context and save stack to outside the context set up by call_sv(), crashes and panics ensure. Switching stacks here also starts a new context stack, so the outer loop isn't found and we don't crash. Most other callers to call_sv() (or call_method() etc) do the same. I'm not entirely sure about passing flags = 1 to push_stackinfo(), this matches pp_sort, but not other callers. Fixes #16608 --- cop.h | 1 + deb.c | 3 +- pp_ctl.c | 6 ++++ t/lib/croak/pp_ctl | 68 ++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 77 insertions(+), 1 deletion(-) diff --git a/cop.h b/cop.h index d10d843f26d4..cd11c5758632 100644 --- a/cop.h +++ b/cop.h @@ -1258,6 +1258,7 @@ struct context { #define PERLSI_REQUIRE 9 #define PERLSI_MULTICALL 10 #define PERLSI_REGCOMP 11 +#define PERLSI_SMARTMATCH 12 struct stackinfo { AV * si_stack; /* stack for current runlevel */ diff --git a/deb.c b/deb.c index a5ad066df462..3dfe4ca58e4c 100644 --- a/deb.c +++ b/deb.c @@ -237,7 +237,8 @@ static const char * const si_names[] = { "DIEHOOK", "REQUIRE", "MULTICALL", - "REGCOMP" + "REGCOMP", + "SMARTMATCH" }; #endif diff --git a/pp_ctl.c b/pp_ctl.c index 70a53f06fc72..ae4a4f2b0b73 100644 --- a/pp_ctl.c +++ b/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); diff --git a/t/lib/croak/pp_ctl b/t/lib/croak/pp_ctl index 179c8d7aea89..96f40cd458af 100644 --- a/t/lib/croak/pp_ctl +++ b/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. From 9996c0d8653f968900fca0ba0a13feefdcebb23e Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Wed, 9 Apr 2025 14:39:07 +1000 Subject: [PATCH 3/4] class.c, injected_constructor: prevent loop exits exiting Using last, next etc would pop the context stack to above the call_sv(), generally resulting in a crash or assertion failure. The search the context to pop to stops at the top of the current context stack, and PUSHSTACKi() switches to a new stack, preventing the search from finding any loop outside the call_sv() Similar to #16608 --- class.c | 5 +++++ cop.h | 1 + deb.c | 3 ++- t/lib/croak/class | 28 ++++++++++++++++++++++++++++ 4 files changed, 36 insertions(+), 1 deletion(-) diff --git a/class.c b/class.c index 2b61838dea2e..0c4889d875c6 100644 --- a/class.c +++ b/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); diff --git a/cop.h b/cop.h index cd11c5758632..a1d1ffba3c5e 100644 --- a/cop.h +++ b/cop.h @@ -1259,6 +1259,7 @@ struct context { #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 */ diff --git a/deb.c b/deb.c index 3dfe4ca58e4c..3fe147d12924 100644 --- a/deb.c +++ b/deb.c @@ -238,7 +238,8 @@ static const char * const si_names[] = { "REQUIRE", "MULTICALL", "REGCOMP", - "SMARTMATCH" + "SMARTMATCH", + "CONSTRUCTOR" }; #endif diff --git a/t/lib/croak/class b/t/lib/croak/class index 5ad8df90ef43..9f5db208e812 100644 --- a/t/lib/croak/class +++ b/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. From 779addcdc6fab5ca618b4eb630acc003a093d984 Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Wed, 9 Apr 2025 15:03:45 +1000 Subject: [PATCH 4/4] perldelta for smartmatch, class constructors exiting with loop exits --- pod/perldelta.pod | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/pod/perldelta.pod b/pod/perldelta.pod index afd63c046494..673e61dbc881 100644 --- a/pod/perldelta.pod +++ b/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 would crash perl. [GH #16608] + +=item * + +Class initializers and C blocks, per L, that +called C or other loop exits would crash perl. Same cause as +for [GH #16608]. + =back =head1 Known Problems