Skip to content

Commit 7a873fe

Browse files
tonycozmauke
authored andcommitted
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
1 parent 6e11001 commit 7a873fe

File tree

4 files changed

+77
-1
lines changed

4 files changed

+77
-1
lines changed

cop.h

+1
Original file line numberDiff line numberDiff line change
@@ -1258,6 +1258,7 @@ struct context {
12581258
#define PERLSI_REQUIRE 9
12591259
#define PERLSI_MULTICALL 10
12601260
#define PERLSI_REGCOMP 11
1261+
#define PERLSI_SMARTMATCH 12
12611262

12621263
struct stackinfo {
12631264
AV * si_stack; /* stack for current runlevel */

deb.c

+2-1
Original file line numberDiff line numberDiff line change
@@ -237,7 +237,8 @@ static const char * const si_names[] = {
237237
"DIEHOOK",
238238
"REQUIRE",
239239
"MULTICALL",
240-
"REGCOMP"
240+
"REGCOMP",
241+
"SMARTMATCH"
241242
};
242243
#endif
243244

pp_ctl.c

+6
Original file line numberDiff line numberDiff line change
@@ -5941,6 +5941,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other, const bool copied)
59415941
DEBUG_M(Perl_deb(aTHX_ " applying rule Hash-CodeRef\n"));
59425942
if (numkeys == 0)
59435943
goto ret_yes;
5944+
push_stackinfo(PERLSI_SMARTMATCH, 1);
59445945
while ( (he = hv_iternext(hv)) ) {
59455946
DEBUG_M(Perl_deb(aTHX_ " testing hash key...\n"));
59465947
ENTER_with_name("smartmatch_hash_key_test");
@@ -5953,6 +5954,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other, const bool copied)
59535954
FREETMPS;
59545955
LEAVE_with_name("smartmatch_hash_key_test");
59555956
}
5957+
pop_stackinfo();
59565958
if (andedresults)
59575959
goto ret_yes;
59585960
else
@@ -5967,6 +5969,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other, const bool copied)
59675969
DEBUG_M(Perl_deb(aTHX_ " applying rule Array-CodeRef\n"));
59685970
if (len == 0)
59695971
goto ret_yes;
5972+
push_stackinfo(PERLSI_SMARTMATCH, 1);
59705973
for (i = 0; i < len; ++i) {
59715974
SV * const * const svp = av_fetch(av, i, FALSE);
59725975
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)
59815984
FREETMPS;
59825985
LEAVE_with_name("smartmatch_array_elem_test");
59835986
}
5987+
pop_stackinfo();
59845988
if (andedresults)
59855989
goto ret_yes;
59865990
else
@@ -5989,12 +5993,14 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other, const bool copied)
59895993
else {
59905994
sm_any_sub:
59915995
DEBUG_M(Perl_deb(aTHX_ " applying rule Any-CodeRef\n"));
5996+
push_stackinfo(PERLSI_SMARTMATCH, 1);
59925997
ENTER_with_name("smartmatch_coderef");
59935998
PUSHMARK(PL_stack_sp);
59945999
rpp_xpush_1(d);
59956000
(void)call_sv(e, G_SCALAR);
59966001
LEAVE_with_name("smartmatch_coderef");
59976002
SV *retsv = *PL_stack_sp--;
6003+
pop_stackinfo();
59986004
rpp_replace_2_1(retsv);
59996005
#ifdef PERL_RC_STACK
60006006
SvREFCNT_dec(retsv);

t/lib/croak/pp_ctl

+68
Original file line numberDiff line numberDiff line change
@@ -57,3 +57,71 @@ die;
5757
EXPECT
5858
Unmatched ) in regex; marked by <-- HERE in m/_) <-- HERE / at (eval 1) line 1.
5959
...propagated at - line 2.
60+
########
61+
# NAME last from smartmatch CV
62+
0 ~~ sub {last} for 0
63+
EXPECT
64+
Can't "last" outside a loop block at - line 1.
65+
########
66+
# NAME redo from smartmatch CV
67+
0 ~~ sub {redo} for 0
68+
EXPECT
69+
Can't "redo" outside a loop block at - line 1.
70+
########
71+
# NAME next from smartmatch CV
72+
0 ~~ sub {next} for 0
73+
EXPECT
74+
Can't "next" outside a loop block at - line 1.
75+
########
76+
# NAME goto loop label from smartmatch CV
77+
FOO: 0~~sub{goto FOO} for 0
78+
EXPECT
79+
Can't find label FOO at - line 1.
80+
########
81+
# NAME last from smartmatch CV against array
82+
my @x = (0);
83+
@x ~~ sub {last} for 0
84+
EXPECT
85+
Can't "last" outside a loop block at - line 2.
86+
########
87+
# NAME redo from smartmatch CV against array
88+
my @x = (0);
89+
@x ~~ sub {redo} for 0
90+
EXPECT
91+
Can't "redo" outside a loop block at - line 2.
92+
########
93+
# NAME next from smartmatch CV against array
94+
my @x = (0);
95+
@x ~~ sub {next} for 0
96+
EXPECT
97+
Can't "next" outside a loop block at - line 2.
98+
########
99+
# NAME goto loop label from smartmatch CV against array
100+
my @x = (0);
101+
FOO:@x ~~sub{goto FOO} for 0
102+
EXPECT
103+
Can't find label FOO at - line 2.
104+
########
105+
# NAME last from smartmatch CV against hash
106+
my %x = qw(a b);
107+
%x ~~ sub {last} for 0
108+
EXPECT
109+
Can't "last" outside a loop block at - line 2.
110+
########
111+
# NAME redo from smartmatch CV against hash
112+
my %x = qw(a b);
113+
%x ~~ sub {redo} for 0
114+
EXPECT
115+
Can't "redo" outside a loop block at - line 2.
116+
########
117+
# NAME next from smartmatch CV against hash
118+
my %x = qw(a b);
119+
%x ~~ sub {next} for 0
120+
EXPECT
121+
Can't "next" outside a loop block at - line 2.
122+
########
123+
# NAME goto loop label from smartmatch CV against hash
124+
my %x = qw(a b);
125+
FOO:%x ~~sub{goto FOO} for 0
126+
EXPECT
127+
Can't find label FOO at - line 2.

0 commit comments

Comments
 (0)