Get t/uni/cache.t working under minitest

[perl5.git] / t / op / goto.t

diff --git a/t/op/goto.t b/t/op/goto.t
index cb9c6b6..13e6b04 100644 (file)
--- a/t/op/goto.t
+++ b/t/op/goto.t
@@ -10,7 +10,7 @@ BEGIN {
 
 use warnings;
 use strict;
-plan tests => 80;
+plan tests => 94;
 our $TODO;
 
 my $deprecated = 0;
@@ -20,7 +20,7 @@ our $foo;
 while ($?) {
     $foo = 1;
   label1:
-    is($deprecated, 1);
+    is($deprecated, 1, "following label1");
     $deprecated = 0;
     $foo = 2;
     goto label2;
@@ -28,19 +28,19 @@ while ($?) {
     $foo = 0;
     goto label4;
   label3:
-    is($deprecated, 1);
+    is($deprecated, 1, "following label3");
     $deprecated = 0;
     $foo = 4;
     goto label4;
 }
-is($deprecated, 0);
+is($deprecated, 0, "after 'while' loop");
 goto label1;
 
 $foo = 3;
 
 label2:
 is($foo, 2, 'escape while loop');
-is($deprecated, 0);
+is($deprecated, 0, "following label2");
 goto label3;
 
 label4:
@@ -183,17 +183,17 @@ 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);
+    is($deprecated, 0, "before calling sub a()");
     a();
     ok($ok, '#19061 loop label wiped away by goto');
-    is($deprecated, 1);
+    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);
+    is($deprecated, 1, "following goto and for(;;) loop");
     $deprecated = 0;
 }
 
@@ -460,12 +460,60 @@ a32039();
 
 # goto &foo not allowed in evals
 
-
 sub null { 1 };
 eval 'goto &null';
 like($@, qr/Can't goto subroutine from an eval-string/, 'eval string');
 eval { goto &null };
 like($@, qr/Can't goto subroutine from an eval-block/, 'eval block');
+ 
+# goto &foo leaves @_ alone when called from a sub
+sub returnarg { $_[0] };
+is sub {
+    local *_ = ["ick and queasy"];
+    goto &returnarg;
+}->("quick and easy"), "ick and queasy",
+  'goto &foo with *_{ARRAY} replaced';
+my @__ = "\xc4\x80";
+sub { local *_ = \@__; goto &utf8::decode }->("no thinking aloud");
+is "@__", chr 256, 'goto &xsub with replaced *_{ARRAY}';
+
+# And goto &foo should leave reified @_ alone
+sub { *__ = \@_;  goto &null } -> ("rough and tubbery");
+is ${*__}[0], 'rough and tubbery', 'goto &foo leaves reified @_ alone';
+
+# goto &xsub when @_ has nonexistent elements
+{
+    no warnings "uninitialized";
+    local @_ = ();
+    $#_++;
+    & {sub { goto &utf8::encode }};
+    is @_, 1, 'num of elems in @_ after goto &xsub with nonexistent $_[0]';
+    is $_[0], "", 'content of nonexistent $_[0] is modified by goto &xsub';
+}
+
+# goto &xsub when @_ itself does not exist
+undef *_;
+eval { & { sub { goto &utf8::encode } } };
+# The main thing we are testing is that it did not crash.  But make sure 
+# *_{ARRAY} was untouched, too.
+is *_{ARRAY}, undef, 'goto &xsub when @_ does not exist';
+
+# goto &perlsub when @_ itself does not exist [perl #119949]
+# This was only crashing when the replaced sub call had an argument list.
+# (I.e., &{ sub { goto ... } } did not crash.)
+sub {
+    undef *_;
+    goto sub {
+       is *_{ARRAY}, undef, 'goto &perlsub when @_ does not exist';
+    }
+}->();
+sub {
+    local *_;
+    goto sub {
+       is *_{ARRAY}, undef, 'goto &sub when @_ does not exist (local *_)';
+    }
+}->();
+
 
 # [perl #36521] goto &foo in warn handler could defeat recursion avoider
 
@@ -488,7 +536,7 @@ TODO: {
     }
 }
 
-is($deprecated, 0);
+is($deprecated, 0, "following TODOed test for #43403");
 
 #74290
 {
@@ -636,3 +684,21 @@ ok(
    same_prefix_labels(),
    "perl 112316: goto and labels with the same prefix doesn't get mixed up"
 );
+
+eval { my $x = ""; goto $x };
+like $@, qr/^goto must have label at /, 'goto $x where $x is empty string';
+eval { goto "" };
+like $@, qr/^goto must have label at /, 'goto ""';
+eval { goto };
+like $@, qr/^goto must have label at /, 'argless goto';
+
+eval { my $x = "\0"; goto $x };
+like $@, qr/^Can't find label \0 at /, 'goto $x where $x begins with \0';
+eval { goto "\0" };
+like $@, qr/^Can't find label \0 at /, 'goto "\0"';
+
+sub TIESCALAR { bless [pop] }
+sub FETCH     { $_[0][0] }
+tie my $t, "", sub { "cluck up porridge" };
+is eval { sub { goto $t }->() }//$@, 'cluck up porridge',
+  'tied arg returning sub ref';