summaryrefslogtreecommitdiff
path: root/pp_ctl.c
diff options
context:
space:
mode:
authorYves Orton <demerphq@gmail.com>2022-11-01 16:40:37 +0100
committerYves Orton <demerphq@gmail.com>2022-11-01 21:17:44 +0100
commitcb4eaf3cc6e921efca96ee9abe9b02e07b4259ee (patch)
tree7148ec8136891fd75e27b5dcac3ee715fa12d4a8 /pp_ctl.c
parentd72e07fc940ee748cb83237a6e5339187e754f5d (diff)
downloadperl-cb4eaf3cc6e921efca96ee9abe9b02e07b4259ee.tar.gz
pp_ctl.c - teach module_true how to deal with blocked requires
If require encounters an @INC hook that blocks the require it ends up with a STUB node as the optree for the LEAVEEVAL. This was causing the module_true logic to segfault. Guarding against the OP_STUB node fixes the problem. This affected the tests for IO::Socket::SSL. Thanks to Graham Knopp for the reduced case, and James Keenan for reporting it in https://github.com/Perl/perl5/issues/20468. This should fix the problem.
Diffstat (limited to 'pp_ctl.c')
-rw-r--r--pp_ctl.c34
1 files changed, 18 insertions, 16 deletions
diff --git a/pp_ctl.c b/pp_ctl.c
index 6b00867563..39994a39b3 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -4867,24 +4867,26 @@ PP(pp_leaveeval)
* feature state out of the COP data it contains.
*/
if (check) {
- const OP *kid = cLISTOPx(check)->op_first;
- const OP *last_state = NULL;
-
- for (; kid; kid = OpSIBLING(kid)) {
- if (
- OP_TYPE_IS_OR_WAS(kid, OP_NEXTSTATE)
- || OP_TYPE_IS_OR_WAS(kid, OP_DBSTATE)
- ){
- last_state = kid;
+ if (!OP_TYPE_IS(check,OP_STUB)) {
+ const OP *kid = cLISTOPx(check)->op_first;
+ const OP *last_state = NULL;
+
+ for (; kid; kid = OpSIBLING(kid)) {
+ if (
+ OP_TYPE_IS_OR_WAS(kid, OP_NEXTSTATE)
+ || OP_TYPE_IS_OR_WAS(kid, OP_DBSTATE)
+ ){
+ last_state = kid;
+ }
}
- }
- if (last_state) {
- PL_curcop = cCOPx(last_state);
- if (FEATURE_MODULE_TRUE_IS_ENABLED) {
- override_return = TRUE;
+ if (last_state) {
+ PL_curcop = cCOPx(last_state);
+ if (FEATURE_MODULE_TRUE_IS_ENABLED) {
+ override_return = TRUE;
+ }
+ } else {
+ NOT_REACHED; /* NOTREACHED */
}
- } else {
- NOT_REACHED; /* NOTREACHED */
}
} else {
NOT_REACHED; /* NOTREACHED */