t/op/goto.t

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