This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
permit goto at top level of multicalled sub
authorZefram <zefram@fysh.org>
Mon, 23 Jan 2017 02:25:50 +0000 (02:25 +0000)
committerZefram <zefram@fysh.org>
Mon, 23 Jan 2017 22:25:42 +0000 (22:25 +0000)
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.

pp_ctl.c
t/op/goto.t

index 2ced82d..f48f301 100644 (file)
--- 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)
index 05f1573..f2f2a25 100644 (file)
@@ -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";