t/op/goto.t

   1 #!./perl
   2
   3 # $RCSfile: goto.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:56 $
   4
   5 # "This IS structured code.  It's just randomly structured."
   6
   7 print "1..9\n";
   8
   9 while ($?) {
  10     $foo = 1;
  11   label1:
  12     $foo = 2;
  13     goto label2;
  14 } continue {
  15     $foo = 0;
  16     goto label4;
  17   label3:
  18     $foo = 4;
  19     goto label4;
  20 }
  21 goto label1;
  22
  23 $foo = 3;
  24
  25 label2:
  26 print "#1\t:$foo: == 2\n";
  27 if ($foo == 2) {print "ok 1\n";} else {print "not ok 1\n";}
  28 goto label3;
  29
  30 label4:
  31 print "#2\t:$foo: == 4\n";
  32 if ($foo == 4) {print "ok 2\n";} else {print "not ok 2\n";}
  33
  34 $PERL = ($^O eq 'MSWin32') ? '.\perl' : './perl';
  35 $x = `$PERL -e "goto foo;" 2>&1`;
  36 if ($x =~ /DCL-W-NOCOMD/) { $x = `\$ mcr sys\$disk:[]perl. -e "goto foo;"`; }
  37
  38 if ($x =~ /label/) {print "ok 3\n";} else {print "not ok 3\n";}
  39
  40 sub foo {
  41     goto bar;
  42     print "not ok 4\n";
  43     return;
  44 bar:
  45     print "ok 4\n";
  46 }
  47
  48 &foo;
  49
  50 sub bar {
  51     $x = 'bypass';
  52     eval "goto $x";
  53 }
  54
  55 &bar;
  56 exit;
  57
  58 FINALE:
  59 print "ok 9\n";
  60 exit;
  61
  62 bypass:
  63 print "ok 5\n";
  64
  65 # Test autoloading mechanism.
  66
  67 sub two {
  68     ($pack, $file, $line) = caller;     # Should indicate original call stats.
  69     print "@_ $pack $file $line" eq "1 2 3 main $FILE $LINE"
  70         ? "ok 7\n"
  71         : "not ok 7\n";
  72 }
  73
  74 sub one {
  75     eval <<'END';
  76     sub one { print "ok 6\n"; goto &two; print "not ok 6\n"; }
  77 END
  78     goto &one;
  79 }
  80
  81 $FILE = __FILE__;
  82 $LINE = __LINE__ + 1;
  83 &one(1,2,3);
  84
  85 $wherever = NOWHERE;
  86 eval { goto $wherever };
  87 print $@ =~ /Can't find label NOWHERE/ ? "ok 8\n" : "not ok 8\n";
  88
  89 $wherever = FINALE;
  90 goto $wherever;