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 $x = `./perl -e 'goto foo;' 2>&1`;
  35 if ($x =~ /DCL-W-NOCOMD/) { $x = `\$ mcr sys\$disk:[]perl. -e "goto foo;"`; }
  36
  37 if ($x =~ /label/) {print "ok 3\n";} else {print "not ok 3\n";}
  38
  39 sub foo {
  40     goto bar;
  41     print "not ok 4\n";
  42     return;
  43 bar:
  44     print "ok 4\n";
  45 }
  46
  47 &foo;
  48
  49 sub bar {
  50     $x = 'bypass';
  51     eval "goto $x";
  52 }
  53
  54 &bar;
  55 exit;
  56
  57 FINALE:
  58 print "ok 9\n";
  59 exit;
  60
  61 bypass:
  62 print "ok 5\n";
  63
  64 # Test autoloading mechanism.
  65
  66 sub two {
  67     ($pack, $file, $line) = caller;     # Should indicate original call stats.
  68     print "@_ $pack $file $line" eq "1 2 3 main $FILE $LINE"
  69         ? "ok 7\n"
  70         : "not ok 7\n";
  71 }
  72
  73 sub one {
  74     eval <<'END';
  75     sub one { print "ok 6\n"; goto &two; print "not ok 6\n"; }
  76 END
  77     goto &one;
  78 }
  79
  80 $FILE = __FILE__;
  81 $LINE = __LINE__ + 1;
  82 &one(1,2,3);
  83
  84 $wherever = NOWHERE;
  85 eval { goto $wherever };
  86 print $@ =~ /Can't find label NOWHERE/ ? "ok 8\n" : "not ok 8\n";
  87
  88 $wherever = FINALE;
  89 goto $wherever;