In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/3c157b3cf0631c69ffa5aa2d55b9199bf93b22a9?hp=7cb258c16018b4c963dd48cee7578d26045ff04c>
- Log ----------------------------------------------------------------- commit 3c157b3cf0631c69ffa5aa2d55b9199bf93b22a9 Author: Zefram <[email protected]> Date: Mon Jan 23 02:25:50 2017 +0000 permit goto at top level of multicalled sub A multicalled sub is reckoned to be a pseudo block, out of which it is not permissible to goto. However, the test for a pseudo block was being applied too early, preventing not just escape from a multicalled sub but also a goto at the top level within the sub. This is a bug similar, but not identical, to [perl #113938]. Now the test is deferred, permitting goto at the sub's top level but still forbidding goto out of it. ----------------------------------------------------------------------- Summary of changes: pp_ctl.c | 11 ++++++----- t/op/goto.t | 11 ++++++++++- 2 files changed, 16 insertions(+), 6 deletions(-) diff --git a/pp_ctl.c b/pp_ctl.c index 2ced82dc07..f48f3013ce 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -2946,6 +2946,7 @@ PP(pp_goto) OP *gotoprobe = NULL; bool leaving_eval = FALSE; bool in_block = FALSE; + bool pseudo_block = FALSE; PERL_CONTEXT *last_eval_cx = NULL; /* find label */ @@ -2984,11 +2985,9 @@ PP(pp_goto) gotoprobe = PL_main_root; break; case CXt_SUB: - if (CvDEPTH(cx->blk_sub.cv) && !CxMULTICALL(cx)) { - gotoprobe = CvROOT(cx->blk_sub.cv); - break; - } - /* FALLTHROUGH */ + gotoprobe = CvROOT(cx->blk_sub.cv); + pseudo_block = cBOOL(CxMULTICALL(cx)); + break; case CXt_FORMAT: case CXt_NULL: DIE(aTHX_ "Can't \"goto\" out of a pseudo block"); @@ -3017,6 +3016,8 @@ PP(pp_goto) break; } } + if (pseudo_block) + DIE(aTHX_ "Can't \"goto\" out of a pseudo block"); PL_lastgotoprobe = gotoprobe; } if (!retop) diff --git a/t/op/goto.t b/t/op/goto.t index 05f1573077..f2f2a25af0 100644 --- a/t/op/goto.t +++ b/t/op/goto.t @@ -10,7 +10,7 @@ BEGIN { use warnings; use strict; -plan tests => 99; +plan tests => 100; our $TODO; my $deprecated = 0; @@ -801,3 +801,12 @@ TODO: { } EOC } + +sub revnumcmp ($$) { + goto FOO; + die; + FOO: + return $_[1] <=> $_[0]; +} +is eval { join(":", sort revnumcmp (9,5,1,3,7)) }, "9:7:5:3:1", + "can goto at top level of multicalled sub"; -- Perl5 Master Repository
