t/op/goto.t

   1 #!./perl
   2
   3 # "This IS structured code.  It's just randomly structured."
   4
   5 print "1..16\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 $x = `$PERL -e "goto foo;" 2>&1`;
  34 if ($x =~ /DCL-W-NOCOMD/) { $x = `\$ mcr sys\$disk:[]perl. -e "goto foo;"`; }
  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 exit;
  80
  81 bypass:
  82 print "ok 5\n";
  83
  84 # Test autoloading mechanism.
  85
  86 sub two {
  87     ($pack, $file, $line) = caller;     # Should indicate original call stats.
  88     print "@_ $pack $file $line" eq "1 2 3 main $FILE $LINE"
  89         ? "ok 7\n"
  90         : "not ok 7\n";
  91 }
  92
  93 sub one {
  94     eval <<'END';
  95     sub one { print "ok 6\n"; goto &two; print "not ok 6\n"; }
  96 END
  97     goto &one;
  98 }
  99
 100 $FILE = __FILE__;
 101 $LINE = __LINE__ + 1;
 102 &one(1,2,3);
 103
 104 $wherever = NOWHERE;
 105 eval { goto $wherever };
 106 print $@ =~ /Can't find label NOWHERE/ ? "ok 8\n" : "not ok 8\n";
 107
 108 # see if a modified @_ propagates
 109 {
 110   package Foo;
 111   sub DESTROY   { my $s = shift; print "ok $s->[0]\n"; }
 112   sub show      { print "# @_\nnot ok $_[0][0]\n" if @_ != 5; }
 113   sub start     { push @_, 1, "foo", {}; goto &show; }
 114   for (9..11)   { start(bless([$_]), 'bar'); }
 115 }
 116
 117 sub auto {
 118     goto &loadit;
 119 }
 120
 121 sub AUTOLOAD { print @_ }
 122
 123 auto("ok 12\n");
 124
 125 $wherever = FINALE;
 126 goto $wherever;