t/op/goto.t

   1 #!./perl
   2
   3 # "This IS structured code.  It's just randomly structured."
   4
   5 print "1..22\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' : './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 exit;
 148
 149 bypass:
 150 print "ok 5\n";
 151
 152 # Test autoloading mechanism.
 153
 154 sub two {
 155     ($pack, $file, $line) = caller;     # Should indicate original call stats.
 156     print "@_ $pack $file $line" eq "1 2 3 main $FILE $LINE"
 157         ? "ok 7\n"
 158         : "not ok 7\n";
 159 }
 160
 161 sub one {
 162     eval <<'END';
 163     sub one { print "ok 6\n"; goto &two; print "not ok 6\n"; }
 164 END
 165     goto &one;
 166 }
 167
 168 $FILE = __FILE__;
 169 $LINE = __LINE__ + 1;
 170 &one(1,2,3);
 171
 172 $wherever = NOWHERE;
 173 eval { goto $wherever };
 174 print $@ =~ /Can't find label NOWHERE/ ? "ok 8\n" : "not ok 8\n";
 175
 176 # see if a modified @_ propagates
 177 {
 178   package Foo;
 179   sub DESTROY   { my $s = shift; print "ok $s->[0]\n"; }
 180   sub show      { print "# @_\nnot ok $_[0][0]\n" if @_ != 5; }
 181   sub start     { push @_, 1, "foo", {}; goto &show; }
 182   for (9..11)   { start(bless([$_]), 'bar'); }
 183 }
 184
 185 sub auto {
 186     goto &loadit;
 187 }
 188
 189 sub AUTOLOAD { print @_ }
 190
 191 auto("ok 12\n");
 192
 193 $wherever = FINALE;
 194 goto $wherever;