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 => 271 );
+plan( tests => 272 );
 
 $_ = 'david';
 $a = s/david/rules/r;
@@ -1119,3 +1119,15 @@ SKIP: {
                    {stderr => 1 },
                    '[perl #129038 ] s/\xff//l no longer crashes');
 }
+
+# [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