deprecate "goto" to jump into a construct

4 files changed, 40 insertions, 16 deletions

diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod
index ddb5bceeef..fe2a8850c7 100644
--- a/pod/perlfunc.pod
+++ b/pod/perlfunc.pod
@@ -2392,18 +2392,15 @@ X<goto> X<jump> X<jmp>
 
 =item goto &NAME
 
-The C<goto-LABEL> form finds the statement labeled with LABEL and resumes
-execution there.  It may not be used to go into any construct that
-requires initialization, such as a subroutine or a C<foreach> loop.  It
-also can't be used to go into a construct that is optimized away,
-or to get out of a block or subroutine given to C<sort>.
-It can be used to go almost anywhere else within the dynamic scope,
-including out of subroutines, but it's usually better to use some other
-construct such as C<last> or C<die>.  The author of Perl has never felt the
-need to use this form of C<goto> (in Perl, that is--C is another matter).
-(The difference being that C does not offer named loops combined with
-loop control.  Perl does, and this replaces most structured uses of C<goto>
-in other languages.)
+The C<goto-LABEL> form finds the statement labeled with LABEL and
+resumes execution there. It can't be used to get out of a block or
+subroutine given to C<sort>.  It can be used to go almost anywhere
+else within the dynamic scope, including out of subroutines, but it's
+usually better to use some other construct such as C<last> or C<die>.
+The author of Perl has never felt the need to use this form of C<goto>
+(in Perl, that is--C is another matter).  (The difference being that C
+does not offer named loops combined with loop control.  Perl does, and
+this replaces most structured uses of C<goto> in other languages.)
 
 The C<goto-EXPR> form expects a label name, whose scope will be resolved
 dynamically.  This allows for computed C<goto>s per FORTRAN, but isn't
@@ -2411,6 +2408,12 @@ necessarily recommended if you're optimizing for maintainability:
 
     goto ("FOO", "BAR", "GLARCH")[$i];
 
+Use of C<goto-LABEL> or C<goto-EXPR> to jump into a construct is
+deprecated and will issue a warning.  Even then it may not be used to
+go into any construct that requires initialization, such as a
+subroutine or a C<foreach> loop.  It also can't be used to go into a
+construct that is optimized away,
+
 The C<goto-&NAME> form is quite different from the other forms of
 C<goto>.  In fact, it isn't a goto in the normal sense at all, and
 doesn't have the stigma associated with other gotos.  Instead, it
diff --git a/pp_ctl.c b/pp_ctl.c
index 8074b9fed6..cd099c8825 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2698,6 +2698,12 @@ PP(pp_goto)
                     DIE(aTHX_ "Can't \"goto\" into the middle of a foreach loop");
 	}
 
+	if (*enterops && enterops[1]) {
+	    I32 i = enterops[1]->op_type == OP_ENTER && in_block ? 2 : 1;
+	    if (enterops[i])
+		deprecate("\"goto\" to jump into a construct");
+	}
+
 	/* pop unwanted frames */
 
 	if (ix < cxstack_ix) {
diff --git a/t/op/goto.t b/t/op/goto.t
index c79b424b90..5aaf630bb9 100644
--- a/t/op/goto.t
+++ b/t/op/goto.t
@@ -10,28 +10,37 @@ BEGIN {
 
 use warnings;
 use strict;
-plan tests => 58;
+plan tests => 66;
 our $TODO;
 
+my $deprecated = 0;
+local $SIG{__WARN__} = sub { if ($_[0] =~ m/jump into a construct/) { $deprecated++; } else { warn $_[0] } };
+
 our $foo;
 while ($?) {
     $foo = 1;
   label1:
+    is($deprecated, 1);
+    $deprecated = 0;
     $foo = 2;
     goto label2;
 } continue {
     $foo = 0;
     goto label4;
   label3:
+    is($deprecated, 1);
+    $deprecated = 0;
     $foo = 4;
     goto label4;
 }
+is($deprecated, 0);
 goto label1;
 
 $foo = 3;
 
 label2:
 is($foo, 2, 'escape while loop');
+is($deprecated, 0);
 goto label3;
 
 label4:
@@ -60,7 +69,7 @@ sub bar {
 exit;
 
 FINALE:
-is(curr_test(), 16, 'FINALE');
+is(curr_test(), 20, 'FINALE');
 
 # does goto LABEL handle block contexts correctly?
 # note that this scope-hopping differs from last & next,
@@ -174,13 +183,18 @@ ok($ok, 'works correctly in a nested eval string');
 	A: { if ($false) { redo A; B: $ok = 1; redo A; } }
 	goto B unless $count++;
     }
+    is($deprecated, 0);
     a();
     ok($ok, '#19061 loop label wiped away by goto');
+    is($deprecated, 1);
+    $deprecated = 0;
 
     $ok = 0;
     my $p;
     for ($p=1;$p && goto A;$p=0) { A: $ok = 1 }
     ok($ok, 'weird case of goto and for(;;) loop');
+    is($deprecated, 1);
+    $deprecated = 0;
 }
 
 # bug #9990 - don't prematurely free the CV we're &going to.
@@ -250,7 +264,7 @@ exit;
 
 bypass:
 
-is(curr_test(), 5, 'eval "goto $x"');
+is(curr_test(), 9, 'eval "goto $x"');
 
 # Test autoloading mechanism.
 
@@ -459,3 +473,4 @@ TODO: {
     }
 }
 
+is($deprecated, 0);
diff --git a/t/op/state.t b/t/op/state.t
index 953cd260c0..611dd45217 100644
--- a/t/op/state.t
+++ b/t/op/state.t
@@ -222,9 +222,9 @@ again:
     is $simpson, 'Homer', 'goto 1';
     goto again if @simpsons;
 
-goto Elvis;
 my $vi;
 {
+    goto Elvis unless $vi;
            state $calvin = ++ $vi;
     Elvis: state $vile   = ++ $vi;
     redo unless defined $calvin;