Remove tests which now throw exceptions

At the point at which editing on this file began, only 1 out of 95
scheduled tests would PASS before the new exception would shut the
program down.

This commit performs major surgery on t/op/goto.t.  It removes:

* All tests which would emit the exception, "Use of goto to jump into a
  construct is no longer permitted".

* All tests which were counting the number of deprecation warnings being
  caught by the $SIG{__WARN__} handler, as well as that handler itself.

* All tests which were counting the number of tests run up to a given
  point.

* Some tests whose purpose I could not figure out; more eyeballs welcome.

The total test count is reduced from 95 to 47.  There is a good chance
that certain edge cases which now ought to be exercised *differently*
(from, say, perl-5.42.0) are now not being exercised at all.  Again,
need more eyeballs, especially from people who have been active users of
LABELs and goto LABEL.

Even the tests remain would benefit from re-ordering.  Among other
things, it would be good to have parts of the file exclusively focused
on 'goto LABEL' and other parts exclusively focused on 'goto EXPR'.
(There may, of course, be places where these two flavors mix -- and goto
&NAME is now being tested in t/op/goto-sub.t.)

The file would also benefit from tests that actually generate the
exception.  Perhaps the next step is to take those that have been
removed and place them in individual blocks which start off with 'local
$@;'.

Author: jkeenan

t/op/goto.t

@@ -12,49 +12,31 @@ BEGIN {
 use warnings;
 use strict;
 use Config;
-skip_all("Being overhauled in GH #23618");
-#plan tests => 95;
+plan tests =>  47;
 
 our $TODO;
 
-my $deprecated = 0;
-
-local $SIG{__WARN__} = sub {
-    if ($_[0] =~ m/jump into a construct.*?, and will become fatal in Perl 5\.42/) {
-        $deprecated++;
-    }
-    else { warn $_[0] }
-};
-
 our $foo;
 while ($?) {
     $foo = 1;
   label1:
-    is($deprecated, 1, "following label1");
-    $deprecated = 0;
     $foo = 2;
     goto label2;
 } continue {
     $foo = 0;
     goto label4;
   label3:
-    is($deprecated, 1, "following label3");
-    $deprecated = 0;
     $foo = 4;
     goto label4;
 }
-is($deprecated, 0, "after 'while' loop");
-goto label1;
 
 $foo = 3;
 
 label2:
-is($foo, 2, 'escape while loop');
-is($deprecated, 0, "following label2");
-goto label3;
+is($foo, 3, 'escape while loop');
 
 label4:
-is($foo, 4, 'second escape while loop');
+is($foo, 3, 'second escape while loop');
 
 my $r = run_perl(prog => 'goto foo;', stderr => 1);
 like($r, qr/label/, 'cant find label');
@@ -76,11 +58,7 @@ sub bar {
 }
 
 &bar;
-fail('goto bypass');
-exit;
-
-FINALE:
-is(curr_test(), 11, 'FINALE');
+pass('goto bypass');
 
 # does goto LABEL handle block contexts correctly?
 # note that this scope-hopping differs from last & next,
@@ -192,20 +170,10 @@ ok($ok, 'works correctly in a nested eval string');
     $ok = 0;
     sub a {
 	A: { if ($false) { redo A; B: $ok = 1; redo A; } }
-	goto B unless $count++;
     }
-    is($deprecated, 0, "before calling sub a()");
     a();
-    ok($ok, '#19061 loop label wiped away by goto');
-    is($deprecated, 1, "after calling sub a()");
-    $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, "following goto and for(;;) loop");
-    $deprecated = 0;
 }
 
 # bug #22181 - this used to coredump or make $x undefined, due to
@@ -250,110 +218,6 @@ returned_label:
 is($count, 1, 'called i_return_a_label');
 ok($ok, 'skipped to returned_label');
 
-goto moretests;
-fail('goto moretests');
-exit;
-
-bypass:
-
-is(curr_test(), 9, 'eval "goto $x"');
-
-{
-    my $wherever = 'NOWHERE';
-    eval { goto $wherever };
-    like($@, qr/Can't find label NOWHERE/, 'goto NOWHERE sets $@');
-}
-
-{
-    my $wherever = 'FINALE';
-    goto $wherever;
-}
-fail('goto $wherever');
-
-moretests:
-# test goto duplicated labels.
-{
-    my $z = 0;
-    eval {
-	$z = 0;
-	for (0..1) {
-	  L4: # not outer scope
-	    $z += 10;
-	    last;
-	}
-	goto L4 if $z == 10;
-	last;
-    };
-    like($@, qr/Can't "goto" into the middle of a foreach loop/,
-	    'catch goto middle of foreach');
-
-    $z = 0;
-    # ambiguous label resolution (outer scope means endless loop!)
-  L1:
-    for my $x (0..1) {
-	$z += 10;
-	is($z, 10, 'prefer same scope (loop body) to outer scope (loop entry)');
-	goto L1 unless $x;
-	$z += 10;
-      L1:
-	is($z, 10, 'prefer same scope: second');
-	last;
-    }
-
-    $z = 0;
-  L2: 
-    { 
-	$z += 10;
-	is($z, 10, 'prefer this scope (block body) to outer scope (block entry)');
-	goto L2 if $z == 10;
-	$z += 10;
-      L2:
-	is($z, 10, 'prefer this scope: second');
-    }
-
-
-    { 
-	$z = 0;
-	while (1) {
-	  L3: # not inner scope
-	    $z += 10;
-	    last;
-	}
-	is($z, 10, 'prefer this scope to inner scope');
-	goto L3 if $z == 10;
-	$z += 10;
-      L3: # this scope !
-	is($z, 10, 'prefer this scope to inner scope: second');
-    }
-
-  L4: # not outer scope
-    { 
-	$z = 0;
-	while (1) {
-	  L4: # not inner scope
-	    $z += 1;
-	    last;
-	}
-	is($z, 1, 'prefer this scope to inner,outer scopes');
-	goto L4 if $z == 1;
-	$z += 10;
-      L4: # this scope !
-	is($z, 1, 'prefer this scope to inner,outer scopes: second');
-    }
-
-    {
-	my $loop = 0;
-	for my $x (0..1) { 
-	  L2: # without this, fails 1 (middle) out of 3 iterations
-	    $z = 0;
-	  L2: 
-	    $z += 10;
-	    is($z, 10,
-		"same label, multiple times in same scope (choose 1st) $loop");
-	    goto L2 if $z == 10 and not $loop++;
-	}
-    }
-}
 
 # This bug was introduced in Aug 2010 by commit ac56e7de46621c6f
 # Peephole optimise adjacent pairs of nextstate ops.
@@ -385,8 +249,6 @@ sub DEBUG_TIME() {
     };
 }
 
-is($deprecated, 0, 'no warning was emitted');
-
 {
     my $r = runperl(
 		stderr => 1,
@@ -414,8 +276,6 @@ TODO: {
     }
 }
 
-is($deprecated, 0, "following TODOed test for #43403");
-
 #74290
 {
     my $x;
@@ -610,58 +470,7 @@ sub revnumcmp ($$) {
 is eval { join(":", sort revnumcmp (9,5,1,3,7)) }, "9:7:5:3:1",
   "can goto at top level of multicalled sub";
 
-# A bit strange, but goingto these constructs should not cause any stack
-# problems.  Let’s test them to make sure that is the case.
-no warnings 'deprecated';
-is \sub :lvalue { goto d; ${*{scalar(do { d: \*foo })}} }->(), \$foo,
-   'goto into rv2sv, rv2gv and scalar';
-is sub { goto e; $#{; do { e: \@_ } } }->(1..7), 6,
-   'goto into $#{...}';
-is sub { goto f; prototype \&{; do { f: sub ($) {} } } }->(), '$',
-   'goto into srefgen, prototype and rv2cv';
-is sub { goto g; ref do { g: [] } }->(), 'ARRAY',
-   'goto into ref';
-is sub { goto j; defined undef ${; do { j: \(my $foo = "foo") } } }->(),'',
-   'goto into defined and undef';
-is sub { goto k; study ++${; do { k: \(my $foo = "foo") } } }->(),'1',
-   'goto into study and preincrement';
-is sub { goto l; ~-!${; do { l: \(my $foo = 0) } }++ }->(),~-1,
-   'goto into complement, not, negation and postincrement';
-like sub { goto n; sin cos exp log sqrt do { n: 1 } }->(),qr/^0\.51439/,
-   'goto into sin, cos, exp, log, and sqrt';
-ok sub { goto o; srand do { o: 0 } }->(),
-   'goto into srand';
-cmp_ok sub { goto p; rand do { p: 1 } }->(), '<', 1,
-   'goto into rand';
-is sub { goto r; chr ord length int hex oct abs do { r: -15.5 } }->(), 2,
-   'goto into chr, ord, length, int, hex, oct and abs';
-is sub { goto t; ucfirst lcfirst uc lc do { t: "q" } }->(), 'Q',
-   'goto into ucfirst, lcfirst, uc and lc';
-{ no strict;
-  is sub { goto u; \@{; quotemeta do { u: "." } } }->(), \@{'\.'},
-   'goto into rv2av and quotemeta';
-}
-is join(" ",sub { goto v; %{; do { v: +{1..2} } } }->()), '1 2',
-   'goto into rv2hv';
-is join(" ",sub { goto w; $_ || do { w: "w" } }->()), 'w',
-   'goto into rhs of or';
-is join(" ",sub { goto x; $_ && do { x: "w" } }->()), 'w',
-   'goto into rhs of and';
-is join(" ",sub { goto z; $_ ? do { z: "w" } : 0 }->()), 'w',
-   'goto into first leg of ?:';
-is join(" ",sub { goto z; $_ ? 0 : do { z: "w" } }->()), 'w',
-   'goto into second leg of ?:';
-is sub { goto z; caller do { z: 0 } }->(), 'main',
-   'goto into caller';
-is sub { goto z; exit do { z: return "foo" } }->(), 'foo',
-   'goto into exit';
-is sub { goto z; eval do { z: "'foo'" } }->(), 'foo',
-   'goto into eval';
-TODO: {
-    local $TODO = "glob() does not currently return a list on VMS" if $^O eq 'VMS';
-    is join(",",sub { goto z; glob do { z: "foo bar" } }->()), 'foo,bar',
-       'goto into glob';
-}
+
 # [perl #132799]
 # Erroneous inward goto warning, followed by crash.
 # The eval must be in an assignment.
@@ -674,13 +483,3 @@ sub _routine {
 _routine();
 pass("bug 132799");
 
-# [perl #132854]
-# Goto the *first* parameter of a binary expression, which is harmless.
-eval {
-    goto __GEN_2;
-    my $sent = do {
-        __GEN_2:
-    };
-};
-is $@,'', 'goto the first parameter of a binary expression [perl #132854]';
-