t/op/goto.t

   1 #!./perl
   2
   3 # "This IS structured code.  It's just randomly structured."
   4
   5 BEGIN {
   6     chdir 't' if -d 't';
   7     @INC = qw(. ../lib);
   8 }
   9
  10 print "1..30\n";
  11
  12 require "test.pl";
  13
  14 while ($?) {
  15     $foo = 1;
  16   label1:
  17     $foo = 2;
  18     goto label2;
  19 } continue {
  20     $foo = 0;
  21     goto label4;
  22   label3:
  23     $foo = 4;
  24     goto label4;
  25 }
  26 goto label1;
  27
  28 $foo = 3;
  29
  30 label2:
  31 print "#1\t:$foo: == 2\n";
  32 if ($foo == 2) {print "ok 1\n";} else {print "not ok 1\n";}
  33 goto label3;
  34
  35 label4:
  36 print "#2\t:$foo: == 4\n";
  37 if ($foo == 4) {print "ok 2\n";} else {print "not ok 2\n";}
  38
  39 $PERL = ($^O eq 'MSWin32') ? '.\perl' : ($^O eq 'MacOS') ? $^X : ($^O eq 'NetWare') ? 'perl' : './perl';
  40 $CMD = qq[$PERL -e "goto foo;" 2>&1 ];
  41 $x = `$CMD`;
  42
  43 if ($x =~ /label/) {print "ok 3\n";} else {print "not ok 3\n";}
  44
  45 sub foo {
  46     goto bar;
  47     print "not ok 4\n";
  48     return;
  49 bar:
  50     print "ok 4\n";
  51 }
  52
  53 &foo;
  54
  55 sub bar {
  56     $x = 'bypass';
  57     eval "goto $x";
  58 }
  59
  60 &bar;
  61 exit;
  62
  63 FINALE:
  64 print "ok 13\n";
  65
  66 # does goto LABEL handle block contexts correctly?
  67
  68 my $cond = 1;
  69 for (1) {
  70     if ($cond == 1) {
  71         $cond = 0;
  72         goto OTHER;
  73     }
  74     elsif ($cond == 0) {
  75       OTHER:
  76         $cond = 2;
  77         print "ok 14\n";
  78         goto THIRD;
  79     }
  80     else {
  81       THIRD:
  82         print "ok 15\n";
  83     }
  84 }
  85 print "ok 16\n";
  86
  87 # Does goto work correctly within a for(;;) loop?
  88 #  (BUG ID 20010309.004)
  89
  90 for(my $i=0;!$i++;) {
  91   my $x=1;
  92   goto label;
  93   label: print (defined $x?"ok ": "not ok ", "17\n")
  94 }
  95
  96 # Does goto work correctly going *to* a for(;;) loop?
  97 #  (make sure it doesn't skip the initializer)
  98
  99 my ($z, $y) = (0);
 100 FORL1: for($y="ok 18\n"; $z;) {print $y; goto TEST19}
 101 ($y,$z) = ("not ok 18\n", 1);
 102 goto FORL1;
 103
 104 # Even from within the loop?
 105
 106 TEST19: $z = 0;
 107 FORL2: for($y="ok 19\n"; 1;) {
 108   if ($z) {
 109     print $y;
 110     last;
 111   }
 112   ($y, $z) = ("not ok 19\n", 1);
 113   goto FORL2;
 114 }
 115
 116 # Does goto work correctly within a try block?
 117 #  (BUG ID 20000313.004)
 118
 119 my $ok = 0;
 120 eval {
 121   my $variable = 1;
 122   goto LABEL20;
 123   LABEL20: $ok = 1 if $variable;
 124 };
 125 print ($ok&&!$@ ? "ok 20\n" : "not ok 20\n");
 126
 127 # And within an eval-string?
 128
 129
 130 $ok = 0;
 131 eval q{
 132   my $variable = 1;
 133   goto LABEL21;
 134   LABEL21: $ok = 1 if $variable;
 135 };
 136 print ($ok&&!$@ ? "ok 21\n" : "not ok 21\n");
 137
 138
 139 # Test that goto works in nested eval-string
 140 $ok = 0;
 141 {eval q{
 142   eval q{
 143     goto LABEL22;
 144   };
 145   $ok = 0;
 146   last;
 147
 148   LABEL22: $ok = 1;
 149 };
 150 $ok = 0 if $@;
 151 }
 152 print ($ok ? "ok 22\n" : "not ok 22\n");
 153
 154 {
 155     my $false = 0;
 156
 157     $ok = 0;
 158     { goto A; A: $ok = 1 } continue { }
 159     print "not " unless $ok;
 160     print "ok 23 - #20357 goto inside /{ } continue { }/ loop\n";
 161
 162     $ok = 0;
 163     { do { goto A; A: $ok = 1 } while $false }
 164     print "not " unless $ok;
 165     print "ok 24 - #20154 goto inside /do { } while ()/ loop\n";
 166
 167     $ok = 0;
 168     foreach(1) { goto A; A: $ok = 1 } continue { };
 169     print "not " unless $ok;
 170     print "ok 25 - goto inside /foreach () { } continue { }/ loop\n";
 171
 172     $ok = 0;
 173     sub a {
 174         A: { if ($false) { redo A; B: $ok = 1; redo A; } }
 175         goto B unless $r++
 176     }
 177     a();
 178     print "not " unless $ok;
 179     print "ok 26 - #19061 loop label wiped away by goto\n";
 180
 181     $ok = 0;
 182     for ($p=1;$p && goto A;$p=0) { A: $ok = 1 }
 183     print "not " unless $ok;
 184     print "ok 27 - weird case of goto and for(;;) loop\n";
 185 }
 186
 187 # bug #9990 - don't prematurely free the CV we're &going to.
 188
 189 sub f1 {
 190     my $x;
 191     goto sub { $x; print "ok 28 - don't prematurely free CV\n" }
 192 }
 193 f1();
 194
 195 # bug #22181 - this used to coredump or make $x undefined, due to
 196 # erroneous popping of the inner BLOCK context
 197
 198 for ($i=0; $i<2; $i++) {
 199     my $x = 1;
 200     goto LABEL29;
 201     LABEL29:
 202     print "not " if !defined $x || $x != 1;
 203 }
 204 print "ok 29 - goto in for(;;) with continuation\n";
 205
 206 # bug #22299 - goto in require doesn't find label
 207
 208 open my $f, ">goto01.pm" or die;
 209 print $f <<'EOT';
 210 package goto01;
 211 goto YYY;
 212 die;
 213 YYY: print "OK\n";
 214 1;
 215 EOT
 216 close $f;
 217
 218 curr_test(30);
 219 my $r = runperl(prog => 'use goto01; print qq[DONE\n]');
 220 is($r, "OK\nDONE\n", "goto within use-d file");
 221 unlink "goto01.pm";
 222
 223
 224 exit;
 225
 226 bypass:
 227 print "ok 5\n";
 228
 229 # Test autoloading mechanism.
 230
 231 sub two {
 232     ($pack, $file, $line) = caller;     # Should indicate original call stats.
 233     print "@_ $pack $file $line" eq "1 2 3 main $FILE $LINE"
 234         ? "ok 7\n"
 235         : "not ok 7\n";
 236 }
 237
 238 sub one {
 239     eval <<'END';
 240     sub one { print "ok 6\n"; goto &two; print "not ok 6\n"; }
 241 END
 242     goto &one;
 243 }
 244
 245 $FILE = __FILE__;
 246 $LINE = __LINE__ + 1;
 247 &one(1,2,3);
 248
 249 $wherever = NOWHERE;
 250 eval { goto $wherever };
 251 print $@ =~ /Can't find label NOWHERE/ ? "ok 8\n" : "not ok 8\n";
 252
 253 # see if a modified @_ propagates
 254 {
 255   package Foo;
 256   sub DESTROY   { my $s = shift; print "ok $s->[0]\n"; }
 257   sub show      { print "# @_\nnot ok $_[0][0]\n" if @_ != 5; }
 258   sub start     { push @_, 1, "foo", {}; goto &show; }
 259   for (9..11)   { start(bless([$_]), 'bar'); }
 260 }
 261
 262 sub auto {
 263     goto &loadit;
 264 }
 265
 266 sub AUTOLOAD { print @_ }
 267
 268 auto("ok 12\n");
 269
 270 $wherever = FINALE;
 271 goto $wherever;