95 lines
2.3 KiB
Diff
95 lines
2.3 KiB
Diff
|
From 2c639acf40b4abc2783352f8e20dbfb68389e633 Mon Sep 17 00:00:00 2001
|
||
|
|
From: David Mitchell <davem@iabyn.com>
|
||
|
|
Date: Mon, 28 Nov 2016 08:03:49 +0000
|
||
|
|
Subject: [PATCH] crash on explicit return from s///e
|
||
|
|
MIME-Version: 1.0
|
||
|
|
Content-Type: text/plain; charset=UTF-8
|
||
|
|
Content-Transfer-Encoding: 8bit
|
||
|
|
|
||
|
|
Petr Pisar: Ported to 5.24.0:
|
||
|
|
|
||
|
|
commit 7332835e5da7b7a793ef814a84e53003be1d0138
|
||
|
|
Author: David Mitchell <davem@iabyn.com>
|
||
|
|
Date: Mon Nov 28 08:03:49 2016 +0000
|
||
|
|
|
||
|
|
crash on explicit return from s///e
|
||
|
|
|
||
|
|
RT #130188
|
||
|
|
|
||
|
|
In
|
||
|
|
|
||
|
|
sub f {
|
||
|
|
my $x = 'a';
|
||
|
|
$x =~ s/./return;/e;
|
||
|
|
}
|
||
|
|
|
||
|
|
the 'return' triggers popping any contexts above the subroutine context:
|
||
|
|
in this case, a CXt_SUBST context. In this case, Perl_dounwind() calls
|
||
|
|
cx_popblock() for the bottom-most popped context, to restore any saved
|
||
|
|
vars. However, CXt_SUBST is the one context type which *doesn't* use
|
||
|
|
'struct block' as part of its context struct union, so you can't
|
||
|
|
cx_popblock() a CXt_SUBST context.
|
||
|
|
|
||
|
|
This commit makes it skip the cx_popblock() in this case.
|
||
|
|
|
||
|
|
Bug was introduced by me with v5.23.7-235-gfc6e609.
|
||
|
|
|
||
|
|
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||
|
|
---
|
||
|
|
pp_ctl.c | 6 ++++++
|
||
|
|
t/re/subst.t | 17 ++++++++++++++++-
|
||
|
|
2 files changed, 22 insertions(+), 1 deletion(-)
|
||
|
|
|
||
|
|
diff --git a/pp_ctl.c b/pp_ctl.c
|
||
|
|
index 99ff59a..b94c09a 100644
|
||
|
|
--- a/pp_ctl.c
|
||
|
|
+++ b/pp_ctl.c
|
||
|
|
@@ -1529,6 +1529,12 @@ Perl_dounwind(pTHX_ I32 cxix)
|
||
|
|
switch (CxTYPE(cx)) {
|
||
|
|
case CXt_SUBST:
|
||
|
|
CX_POPSUBST(cx);
|
||
|
|
+ /* CXt_SUBST is not a block context type, so skip the
|
||
|
|
+ * cx_popblock(cx) below */
|
||
|
|
+ if (cxstack_ix == cxix + 1) {
|
||
|
|
+ cxstack_ix--;
|
||
|
|
+ return;
|
||
|
|
+ }
|
||
|
|
break;
|
||
|
|
case CXt_SUB:
|
||
|
|
cx_popsub(cx);
|
||
|
|
diff --git a/t/re/subst.t b/t/re/subst.t
|
||
|
|
index 26a78c7..c039cc4 100644
|
||
|
|
--- a/t/re/subst.t
|
||
|
|
+++ b/t/re/subst.t
|
||
|
|
@@ -11,7 +11,7 @@ BEGIN {
|
||
|
|
require './loc_tools.pl';
|
||
|
|
}
|
||
|
|
|
||
|
|
-plan( tests => 270 );
|
||
|
|
+plan( tests => 271 );
|
||
|
|
|
||
|
|
$_ = 'david';
|
||
|
|
$a = s/david/rules/r;
|
||
|
|
@@ -1102,3 +1102,18 @@ SKIP: {
|
||
|
|
$s =~ s/..\G//g;
|
||
|
|
is($s, "\x{123}", "#RT 126260 gofs");
|
||
|
|
}
|
||
|
|
+
|
||
|
|
+# [perl #130188] crash on return from substitution in subroutine
|
||
|
|
+# make sure returning from s///e doesn't SEGV
|
||
|
|
+{
|
||
|
|
+ my $f = sub {
|
||
|
|
+ my $x = 'a';
|
||
|
|
+ $x =~ s/./return;/e;
|
||
|
|
+ };
|
||
|
|
+ my $x = $f->();
|
||
|
|
+ pass("RT #130188");
|
||
|
|
+}
|
||
|
|
+
|
||
|
|
+
|
||
|
|
+
|
||
|
|
+
|
||
|
|
--
|
||
|
|
2.7.4
|
||
|
|
|