1#!./perl 2 3# "This IS structured code. It's just randomly structured." 4 5print "1..22\n"; 6 7while ($?) { 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} 19goto label1; 20 21$foo = 3; 22 23label2: 24print "#1\t:$foo: == 2\n"; 25if ($foo == 2) {print "ok 1\n";} else {print "not ok 1\n";} 26goto label3; 27 28label4: 29print "#2\t:$foo: == 4\n"; 30if ($foo == 4) {print "ok 2\n";} else {print "not ok 2\n";} 31 32$PERL = ($^O eq 'MSWin32') ? '.\perl' : ($^O eq 'MacOS') ? $^X : ($^O eq 'NetWare') ? 'perl' : './perl'; 33$CMD = qq[$PERL -e "goto foo;" 2>&1 ]; 34$x = `$CMD`; 35 36if ($x =~ /label/) {print "ok 3\n";} else {print "not ok 3\n";} 37 38sub foo { 39 goto bar; 40 print "not ok 4\n"; 41 return; 42bar: 43 print "ok 4\n"; 44} 45 46&foo; 47 48sub bar { 49 $x = 'bypass'; 50 eval "goto $x"; 51} 52 53&bar; 54exit; 55 56FINALE: 57print "ok 13\n"; 58 59# does goto LABEL handle block contexts correctly? 60 61my $cond = 1; 62for (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} 78print "ok 16\n"; 79 80# Does goto work correctly within a for(;;) loop? 81# (BUG ID 20010309.004) 82 83for(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 92my ($z, $y) = (0); 93FORL1: for($y="ok 18\n"; $z;) {print $y; goto TEST19} 94($y,$z) = ("not ok 18\n", 1); 95goto FORL1; 96 97# Even from within the loop? 98 99TEST19: $z = 0; 100FORL2: 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 112my $ok = 0; 113eval { 114 my $variable = 1; 115 goto LABEL20; 116 LABEL20: $ok = 1 if $variable; 117}; 118print ($ok&&!$@ ? "ok 20\n" : "not ok 20\n"); 119 120# And within an eval-string? 121 122 123$ok = 0; 124eval q{ 125 my $variable = 1; 126 goto LABEL21; 127 LABEL21: $ok = 1 if $variable; 128}; 129print ($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} 145print ($ok ? "ok 22\n" : "not ok 22\n"); 146 147exit; 148 149bypass: 150print "ok 5\n"; 151 152# Test autoloading mechanism. 153 154sub 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 161sub one { 162 eval <<'END'; 163 sub one { print "ok 6\n"; goto &two; print "not ok 6\n"; } 164END 165 goto &one; 166} 167 168$FILE = __FILE__; 169$LINE = __LINE__ + 1; 170&one(1,2,3); 171 172$wherever = NOWHERE; 173eval { goto $wherever }; 174print $@ =~ /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 185sub auto { 186 goto &loadit; 187} 188 189sub AUTOLOAD { print @_ } 190 191auto("ok 12\n"); 192 193$wherever = FINALE; 194goto $wherever; 195