|
 |
b8876f |
From 0a1ddbeaeeea3c690c2408bd4c3a61c05cb9695f Mon Sep 17 00:00:00 2001
|
|
|
b8876f |
From: Zefram <zefram@fysh.org>
|
|
|
b8876f |
Date: Mon, 23 Jan 2017 02:25:50 +0000
|
|
|
b8876f |
Subject: [PATCH] permit goto at top level of multicalled sub
|
|
|
b8876f |
MIME-Version: 1.0
|
|
|
b8876f |
Content-Type: text/plain; charset=UTF-8
|
|
|
b8876f |
Content-Transfer-Encoding: 8bit
|
|
|
b8876f |
|
|
|
b8876f |
Petr Písař: Ported to 5.24.1:
|
|
|
b8876f |
|
|
|
b8876f |
commit 3c157b3cf0631c69ffa5aa2d55b9199bf93b22a9
|
|
|
b8876f |
Author: Zefram <zefram@fysh.org>
|
|
|
b8876f |
Date: Mon Jan 23 02:25:50 2017 +0000
|
|
|
b8876f |
|
|
|
b8876f |
permit goto at top level of multicalled sub
|
|
|
b8876f |
|
|
|
b8876f |
A multicalled sub is reckoned to be a pseudo block, out of which it is
|
|
|
b8876f |
not permissible to goto. However, the test for a pseudo block was being
|
|
|
b8876f |
applied too early, preventing not just escape from a multicalled sub but
|
|
|
b8876f |
also a goto at the top level within the sub. This is a bug similar, but
|
|
|
b8876f |
not identical, to [perl #113938]. Now the test is deferred, permitting
|
|
|
b8876f |
goto at the sub's top level but still forbidding goto out of it.
|
|
|
b8876f |
|
|
|
b8876f |
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
|
|
b8876f |
---
|
|
|
b8876f |
pp_ctl.c | 11 ++++++-----
|
|
|
b8876f |
t/op/goto.t | 11 ++++++++++-
|
|
|
b8876f |
2 files changed, 16 insertions(+), 6 deletions(-)
|
|
|
b8876f |
|
|
|
b8876f |
diff --git a/pp_ctl.c b/pp_ctl.c
|
|
|
b8876f |
index e859e01..a1fc2f4 100644
|
|
|
b8876f |
--- a/pp_ctl.c
|
|
|
b8876f |
+++ b/pp_ctl.c
|
|
|
b8876f |
@@ -2921,6 +2921,7 @@ PP(pp_goto)
|
|
|
b8876f |
OP *gotoprobe = NULL;
|
|
|
b8876f |
bool leaving_eval = FALSE;
|
|
|
b8876f |
bool in_block = FALSE;
|
|
|
b8876f |
+ bool pseudo_block = FALSE;
|
|
|
b8876f |
PERL_CONTEXT *last_eval_cx = NULL;
|
|
|
b8876f |
|
|
|
b8876f |
/* find label */
|
|
|
b8876f |
@@ -2959,11 +2960,9 @@ PP(pp_goto)
|
|
|
b8876f |
gotoprobe = PL_main_root;
|
|
|
b8876f |
break;
|
|
|
b8876f |
case CXt_SUB:
|
|
|
b8876f |
- if (CvDEPTH(cx->blk_sub.cv) && !CxMULTICALL(cx)) {
|
|
|
b8876f |
- gotoprobe = CvROOT(cx->blk_sub.cv);
|
|
|
b8876f |
- break;
|
|
|
b8876f |
- }
|
|
|
b8876f |
- /* FALLTHROUGH */
|
|
|
b8876f |
+ gotoprobe = CvROOT(cx->blk_sub.cv);
|
|
|
b8876f |
+ pseudo_block = cBOOL(CxMULTICALL(cx));
|
|
|
b8876f |
+ break;
|
|
|
b8876f |
case CXt_FORMAT:
|
|
|
b8876f |
case CXt_NULL:
|
|
|
b8876f |
DIE(aTHX_ "Can't \"goto\" out of a pseudo block");
|
|
|
b8876f |
@@ -2992,6 +2991,8 @@ PP(pp_goto)
|
|
|
b8876f |
break;
|
|
|
b8876f |
}
|
|
|
b8876f |
}
|
|
|
b8876f |
+ if (pseudo_block)
|
|
|
b8876f |
+ DIE(aTHX_ "Can't \"goto\" out of a pseudo block");
|
|
|
b8876f |
PL_lastgotoprobe = gotoprobe;
|
|
|
b8876f |
}
|
|
|
b8876f |
if (!retop)
|
|
|
b8876f |
diff --git a/t/op/goto.t b/t/op/goto.t
|
|
|
b8876f |
index aa2f24f..07bd6fb 100644
|
|
|
b8876f |
--- a/t/op/goto.t
|
|
|
b8876f |
+++ b/t/op/goto.t
|
|
|
b8876f |
@@ -10,7 +10,7 @@ BEGIN {
|
|
|
b8876f |
|
|
|
b8876f |
use warnings;
|
|
|
b8876f |
use strict;
|
|
|
b8876f |
-plan tests => 98;
|
|
|
b8876f |
+plan tests => 99;
|
|
|
b8876f |
our $TODO;
|
|
|
b8876f |
|
|
|
b8876f |
my $deprecated = 0;
|
|
|
b8876f |
@@ -774,3 +774,12 @@ sub FETCH { $_[0][0] }
|
|
|
b8876f |
tie my $t, "", sub { "cluck up porridge" };
|
|
|
b8876f |
is eval { sub { goto $t }->() }//$@, 'cluck up porridge',
|
|
|
b8876f |
'tied arg returning sub ref';
|
|
|
b8876f |
+
|
|
|
b8876f |
+sub revnumcmp ($$) {
|
|
|
b8876f |
+ goto FOO;
|
|
|
b8876f |
+ die;
|
|
|
b8876f |
+ FOO:
|
|
|
b8876f |
+ return $_[1] <=> $_[0];
|
|
|
b8876f |
+}
|
|
|
b8876f |
+is eval { join(":", sort revnumcmp (9,5,1,3,7)) }, "9:7:5:3:1",
|
|
|
b8876f |
+ "can goto at top level of multicalled sub";
|
|
|
b8876f |
--
|
|
|
b8876f |
2.7.4
|
|
|
b8876f |
|