Skip to content

Commit 6372338

Browse files
maukemauke
committed
newFOROP: fix crash when optimizing 2-var for over builtin::indexed
OP_ENTERSUB isn't necessarily a LISTOP, apparently, so we can't just grab its op_last. Instead, copy/paste logic from elsewhere in op.c to find the cvop. Also, avoid crashing on "fake" pad entries that represent lexical subs from outer scopes by climbing up the scope chain until we reach a real pad entry. Fixes #23405.
1 parent 9ef5300 commit 6372338

File tree

3 files changed

+166
-12
lines changed

3 files changed

+166
-12
lines changed

‎op.c

Lines changed: 39 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -9646,6 +9646,35 @@ Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP *loop,
96469646
return o;
96479647
}
96489648

9649+
#define resolve_lex_sv(t) S_resolve_lex_sv(aTHX_ t)
9650+
static SV *
9651+
S_resolve_lex_sv(pTHX_ PADOFFSET t) {
9652+
CV *cv = PL_compcv;
9653+
PADNAME **pna = PadnamelistARRAY(PL_comppad_name);
9654+
SV **pa = PL_curpad;
9655+
PADNAME *pn;
9656+
9657+
while (pn = pna[t], PadnameOUTER(pn)) {
9658+
t = PARENT_PAD_INDEX(pn);
9659+
9660+
cv = CvOUTSIDE(cv);
9661+
assert(cv);
9662+
9663+
PADLIST *padlist = CvPADLIST(cv);
9664+
pna = PadlistNAMESARRAY(padlist);
9665+
9666+
I32 depth = CvDEPTH(cv);
9667+
if (depth == 0) {
9668+
depth = 1;
9669+
}
9670+
9671+
PAD *pad = PadlistARRAY(padlist)[depth];
9672+
pa = PadARRAY(pad);
9673+
}
9674+
9675+
return pa[t];
9676+
}
9677+
96499678
#define op_is_cv_xsub(o, xsub) S_op_is_cv_xsub(aTHX_ o, xsub)
96509679
static bool
96519680
S_op_is_cv_xsub(pTHX_ OP *o, XSUBADDR_t xsub)
@@ -9665,7 +9694,7 @@ S_op_is_cv_xsub(pTHX_ OP *o, XSUBADDR_t xsub)
96659694
}
96669695

96679696
case OP_PADCV:
9668-
cv = (CV *)PAD_SVl(o->op_targ);
9697+
cv = (CV *)resolve_lex_sv(o->op_targ);
96699698
assert(cv && SvTYPE(cv) == SVt_PVCV);
96709699
break;
96719700

@@ -9683,10 +9712,17 @@ S_op_is_cv_xsub(pTHX_ OP *o, XSUBADDR_t xsub)
96839712
static bool
96849713
S_op_is_call_to_cv_xsub(pTHX_ OP *o, XSUBADDR_t xsub)
96859714
{
9686-
if(o->op_type != OP_ENTERSUB)
9715+
if (o->op_type != OP_ENTERSUB)
96879716
return false;
96889717

9689-
OP *cvop = cLISTOPx(cUNOPo->op_first)->op_last;
9718+
OP *aop = cUNOPo->op_first;
9719+
if (!OpHAS_SIBLING(aop)) {
9720+
aop = cUNOPx(aop)->op_first;
9721+
}
9722+
aop = OpSIBLING(aop);
9723+
OP *cvop;
9724+
for (cvop = aop; OpHAS_SIBLING(cvop); cvop = OpSIBLING(cvop)) ;
9725+
96909726
return op_is_cv_xsub(cvop, xsub);
96919727
}
96929728

‎t/op/for-many.t

Lines changed: 13 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -498,4 +498,17 @@ is($continue, 'xx', 'continue reached twice');
498498
is("@have", "Pointy end Up Flamey end Down", 'for my ($one, $two)');
499499
}
500500

501+
# GH #23405 - segfaults when compiling 2-var for loops
502+
{
503+
my $dummy = sub {};
504+
for my ($x, $y) (main->$dummy) {}
505+
pass '2-var for does not crash on method calls';
506+
507+
my sub dummy {}
508+
sub {
509+
for my ($x, $y) (dummy) {}
510+
}->();
511+
pass '2-var for does not crash on lexical sub calls';
512+
}
513+
501514
done_testing();

‎t/perf/opcount.t

Lines changed: 114 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -698,6 +698,21 @@ test_opcount(0, "multiconcat: local assign",
698698

699699
# builtin:: function calls should be replaced with efficient op implementations
700700
no warnings 'experimental::builtin';
701+
use builtin qw(
702+
blessed
703+
ceil
704+
false
705+
floor
706+
indexed
707+
is_bool
708+
is_tainted
709+
is_weak
710+
refaddr
711+
reftype
712+
true
713+
unweaken
714+
weaken
715+
);
701716

702717
test_opcount(0, "builtin::true/false are replaced with constants",
703718
sub { my $x = builtin::true(); my $y = builtin::false() },
@@ -706,6 +721,13 @@ test_opcount(0, "builtin::true/false are replaced with constants",
706721
const => 2,
707722
});
708723

724+
test_opcount(0, "imported true/false are replaced with constants",
725+
sub { my $x = true(); my $y = false() },
726+
{
727+
entersub => 0,
728+
const => 2,
729+
});
730+
709731
test_opcount(0, "builtin::is_bool is replaced with direct opcode",
710732
sub { my $x; my $y; $y = builtin::is_bool($x); 1; },
711733
{
@@ -715,6 +737,15 @@ test_opcount(0, "builtin::is_bool is replaced with direct opcode",
715737
padsv_store => 1,
716738
});
717739

740+
test_opcount(0, "imported is_bool is replaced with direct opcode",
741+
sub { my $x; my $y; $y = is_bool($x); 1; },
742+
{
743+
entersub => 0,
744+
is_bool => 1,
745+
padsv => 3,
746+
padsv_store => 1,
747+
});
748+
718749
test_opcount(0, "builtin::is_bool gets constant-folded",
719750
sub { builtin::is_bool(123); },
720751
{
@@ -723,48 +754,98 @@ test_opcount(0, "builtin::is_bool gets constant-folded",
723754
const => 1,
724755
});
725756

757+
test_opcount(0, "imported is_bool gets constant-folded",
758+
sub { is_bool(123); },
759+
{
760+
entersub => 0,
761+
is_bool => 0,
762+
const => 1,
763+
});
764+
726765
test_opcount(0, "builtin::weaken is replaced with direct opcode",
727766
sub { my $x = []; builtin::weaken($x); },
728767
{
729768
entersub => 0,
730769
weaken => 1,
731770
});
732771

772+
test_opcount(0, "imported weaken is replaced with direct opcode",
773+
sub { my $x = []; weaken($x); },
774+
{
775+
entersub => 0,
776+
weaken => 1,
777+
});
778+
733779
test_opcount(0, "builtin::unweaken is replaced with direct opcode",
734780
sub { my $x = []; builtin::unweaken($x); },
735781
{
736782
entersub => 0,
737783
unweaken => 1,
738784
});
739785

786+
test_opcount(0, "imported unweaken is replaced with direct opcode",
787+
sub { my $x = []; unweaken($x); },
788+
{
789+
entersub => 0,
790+
unweaken => 1,
791+
});
792+
740793
test_opcount(0, "builtin::is_weak is replaced with direct opcode",
741794
sub { builtin::is_weak([]); },
742795
{
743796
entersub => 0,
744797
is_weak => 1,
745798
});
746799

800+
test_opcount(0, "imported is_weak is replaced with direct opcode",
801+
sub { is_weak([]); },
802+
{
803+
entersub => 0,
804+
is_weak => 1,
805+
});
806+
747807
test_opcount(0, "builtin::blessed is replaced with direct opcode",
748808
sub { builtin::blessed([]); },
749809
{
750810
entersub => 0,
751811
blessed => 1,
752812
});
753813

814+
test_opcount(0, "imported blessed is replaced with direct opcode",
815+
sub { blessed([]); },
816+
{
817+
entersub => 0,
818+
blessed => 1,
819+
});
820+
754821
test_opcount(0, "builtin::refaddr is replaced with direct opcode",
755822
sub { builtin::refaddr([]); },
756823
{
757824
entersub => 0,
758825
refaddr => 1,
759826
});
760827

828+
test_opcount(0, "imported refaddr is replaced with direct opcode",
829+
sub { refaddr([]); },
830+
{
831+
entersub => 0,
832+
refaddr => 1,
833+
});
834+
761835
test_opcount(0, "builtin::reftype is replaced with direct opcode",
762836
sub { builtin::reftype([]); },
763837
{
764838
entersub => 0,
765839
reftype => 1,
766840
});
767841

842+
test_opcount(0, "imported reftype is replaced with direct opcode",
843+
sub { reftype([]); },
844+
{
845+
entersub => 0,
846+
reftype => 1,
847+
});
848+
768849
my $one_point_five = 1.5; # Prevent const-folding.
769850
test_opcount(0, "builtin::ceil is replaced with direct opcode",
770851
sub { builtin::ceil($one_point_five); },
@@ -773,15 +854,22 @@ test_opcount(0, "builtin::ceil is replaced with direct opcode",
773854
ceil => 1,
774855
});
775856

776-
test_opcount(0, "builtin::floor is replaced with direct opcode",
777-
sub { builtin::floor($one_point_five); },
857+
test_opcount(0, "imported ceil is replaced with direct opcode",
858+
sub { ceil($one_point_five); },
859+
{
860+
entersub => 0,
861+
ceil => 1,
862+
});
863+
864+
test_opcount(0, "imported floor is replaced with direct opcode",
865+
sub { floor($one_point_five); },
778866
{
779867
entersub => 0,
780868
floor => 1,
781869
});
782870

783-
test_opcount(0, "builtin::is_tainted is replaced with direct opcode",
784-
sub { builtin::is_tainted($0); },
871+
test_opcount(0, "imported is_tainted is replaced with direct opcode",
872+
sub { is_tainted($0); },
785873
{
786874
entersub => 0,
787875
is_tainted => 1,
@@ -1014,18 +1102,35 @@ test_opcount(0, "Empty anonhash ref and direct lexical assignment",
10141102
test_opcount(0, "foreach 2 lexicals on builtin::indexed ARRAY",
10151103
sub { my @input = (); foreach my ($i, $x) (builtin::indexed @input) { } },
10161104
{
1017-
entersub => 0, # no call to builtin::indexed
1105+
entersub => 0, # no call to builtin::indexed
10181106
enteriter => 1,
1019-
iter => 1,
1020-
padav => 2,
1107+
iter => 1,
1108+
padav => 2,
1109+
});
1110+
1111+
test_opcount(0, "foreach 2 lexicals on imported indexed ARRAY",
1112+
sub { my @input = (); foreach my ($i, $x) (indexed @input) { } },
1113+
{
1114+
entersub => 0, # no call to builtin::indexed
1115+
enteriter => 1,
1116+
iter => 1,
1117+
padav => 2,
10211118
});
10221119

10231120
test_opcount(0, "foreach 2 lexicals on builtin::indexed LIST",
10241121
sub { foreach my ($i, $x) (builtin::indexed qw( x y z )) { } },
10251122
{
1026-
entersub => 0, # no call to builtin::indexed
1123+
entersub => 0, # no call to builtin::indexed
1124+
enteriter => 1,
1125+
iter => 1,
1126+
});
1127+
1128+
test_opcount(0, "foreach 2 lexicals on imported indexed LIST",
1129+
sub { foreach my ($i, $x) (indexed qw( x y z )) { } },
1130+
{
1131+
entersub => 0, # no call to builtin::indexed
10271132
enteriter => 1,
1028-
iter => 1,
1133+
iter => 1,
10291134
});
10301135

10311136
# substr with const zero offset and "" replacements

0 commit comments

Comments
 (0)