contrib/perl5/t/op/goto.t

   1 #!./perl
   2
   3 # "This IS structured code.  It's just randomly structured."
   4
   5 print "1..13\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 exit;
  59
  60 bypass:
  61 print "ok 5\n";
  62
  63 # Test autoloading mechanism.
  64
  65 sub two {
  66     ($pack, $file, $line) = caller;     # Should indicate original call stats.
  67     print "@_ $pack $file $line" eq "1 2 3 main $FILE $LINE"
  68         ? "ok 7\n"
  69         : "not ok 7\n";
  70 }
  71
  72 sub one {
  73     eval <<'END';
  74     sub one { print "ok 6\n"; goto &two; print "not ok 6\n"; }
  75 END
  76     goto &one;
  77 }
  78
  79 $FILE = __FILE__;
  80 $LINE = __LINE__ + 1;
  81 &one(1,2,3);
  82
  83 $wherever = NOWHERE;
  84 eval { goto $wherever };
  85 print $@ =~ /Can't find label NOWHERE/ ? "ok 8\n" : "not ok 8\n";
  86
  87 # see if a modified @_ propagates
  88 {
  89   package Foo;
  90   sub DESTROY   { my $s = shift; print "ok $s->[0]\n"; }
  91   sub show      { print "# @_\nnot ok $_[0][0]\n" if @_ != 5; }
  92   sub start     { push @_, 1, "foo", {}; goto &show; }
  93   for (9..11)   { start(bless([$_]), 'bar'); }
  94 }
  95
  96 sub auto {
  97     goto &loadit;
  98 }
  99
 100 sub AUTOLOAD { print @_ }
 101
 102 auto("ok 12\n");
 103
 104 $wherever = FINALE;
 105 goto $wherever;