make goto into a construct an error

ggoossen · Dec 30, 2010 · baf33fe · baf33fe
1 parent adeb067
commit baf33fe
Show file tree

Hide file tree

Showing 4 changed files with 30 additions and 68 deletions.
diff --git a/pp_ctl.c b/pp_ctl.c
@@ -2849,7 +2849,7 @@ PP(pp_goto)
 	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");
+		DIE(aTHX_ "Can't \"goto\" into a construct");
 	}
 
 	/* pop unwanted frames */

diff --git a/t/comp/package_block.t b/t/comp/package_block.t
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..7\n";
+print "1..6\n";
 
 $main::result = "";
 eval q{
@@ -57,36 +57,19 @@ eval q{
 print $main::result eq "a(2)b(4)c(6)d(8)e(10)f(12)" ? "ok 5\n" : "not ok 5\n";
 
 $main::result = "";
-$main::warning = "";
-$SIG{__WARN__} = sub { $main::warning .= $_[0]; };
 eval q{
     $main::result .= "a(".__PACKAGE__."/".eval("__PACKAGE__").")";
-    goto l0;
-    $main::result .= "b(".__PACKAGE__."/".eval("__PACKAGE__").")";
     package Foo {
-	$main::result .= "c(".__PACKAGE__."/".eval("__PACKAGE__").")";
-	l0:
-	$main::result .= "d(".__PACKAGE__."/".eval("__PACKAGE__").")";
+	$main::result .= "b(".__PACKAGE__."/".eval("__PACKAGE__").")";
 	goto l1;
-	$main::result .= "e(".__PACKAGE__."/".eval("__PACKAGE__").")";
+	$main::result .= "c(".__PACKAGE__."/".eval("__PACKAGE__").")";
     }
-    $main::result .= "f(".__PACKAGE__."/".eval("__PACKAGE__").")";
+    $main::result .= "d(".__PACKAGE__."/".eval("__PACKAGE__").")";
     l1:
-    $main::result .= "g(".__PACKAGE__."/".eval("__PACKAGE__").")";
-    goto l2;
-    $main::result .= "h(".__PACKAGE__."/".eval("__PACKAGE__").")";
-    package Bar {
-	l2:
-	$main::result .= "i(".__PACKAGE__."/".eval("__PACKAGE__").")";
-    }
-    $main::result .= "j(".__PACKAGE__."/".eval("__PACKAGE__").")";
+    $main::result .= "e(".__PACKAGE__."/".eval("__PACKAGE__").")";
 };
 print $main::result eq
-	"a(main/main)d(Foo/Foo)g(main/main)i(Bar/Bar)j(main/main)" ?
-    "ok 6\n" : "not ok 6\n";
-print $main::warning =~ /\A
-	Use\ of\ "goto"\ [^\n]*\ line\ 3\.\n
-	Use\ of\ "goto"\ [^\n]*\ line\ 15\.\n
-    \z/x ? "ok 7\n" : "not ok 7\n";
+	"a(main/main)b(Foo/Foo)e(main/main)" ?
+    "ok 6\n" : "not ok 6 - $main::result\n";
 
 1;
diff --git a/t/op/goto.t b/t/op/goto.t
@@ -10,41 +10,31 @@ BEGIN {
 
 use warnings;
 use strict;
-plan tests => 77;
+plan tests => 69;
 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;
+our $foo = 0;
+label3:
+while ($foo < 2) {
+    if (!$foo) {
+        $foo = 1;
+        goto label2;
+    }
 } continue {
-    $foo = 0;
-    goto label4;
-  label3:
-    is($deprecated, 1);
-    $deprecated = 0;
-    $foo = 4;
+    $foo += 1;
     goto label4;
 }
-is($deprecated, 0);
-goto label1;
+ok(0, "while loop not escaped");
+exit;
 
 $foo = 3;
 
 label2:
-is($foo, 2, 'escape while loop');
-is($deprecated, 0);
+is($foo, 1, 'escape while loop');
 goto label3;
 
 label4:
-is($foo, 4, 'second escape while loop');
+is($foo, 2, 'second escape while loop');
 
 my $r = run_perl(prog => 'goto foo;', stderr => 1);
 like($r, qr/label/, 'cant find label');
@@ -69,7 +59,7 @@ sub bar {
 exit;
 
 FINALE:
-is(curr_test(), 20, 'FINALE');
+is(curr_test(), 16, 'FINALE');
 
 # does goto LABEL handle block contexts correctly?
 # note that this scope-hopping differs from last & next,
@@ -178,23 +168,13 @@ ok($ok, 'works correctly in a nested eval string');
     foreach(1) { goto A; A: $ok = 1 } continue { };
     ok($ok, 'goto inside /foreach () { } continue { }/ loop');
 
-    $ok = 0;
-    sub a {
-	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;
+    fresh_perl_is( "A: { B: 1; }; goto B",
+                   q|Can't "goto" into a construct at - line 1.|,
+                   stderr => 1 );
 
-    $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;
+    fresh_perl_is( 'my $p; for ($p=1;$p && goto A;$p=0) { A: $ok = 1 }',
+                   q|Can't "goto" into a construct at - line 1.|,
+                   stderr => 1 );
 }
 
 # bug #9990 - don't prematurely free the CV we're &going to.
@@ -264,7 +244,7 @@ exit;
 
 bypass:
 
-is(curr_test(), 9, 'eval "goto $x"');
+is(curr_test(), 5, 'eval "goto $x"');
 
 # Test autoloading mechanism.
 
@@ -473,8 +453,6 @@ TODO: {
     }
 }
 
-is($deprecated, 0);
-
 #74290
 {
     my $x;

diff --git a/t/porting/diag.t b/t/porting/diag.t
@@ -303,6 +303,7 @@ Can't coerce readonly %s to string
 Can't coerce readonly %s to string in %s
 Can't fix broken locale name "%s"
 Can't get short module name from a handle
+Can't "goto" into a construct
 Can't goto subroutine from an eval-block
 Can't goto subroutine from an eval-string
 Can't locate object method "%s" via package "%s" (perhaps you forgot to load "%s"?)