3 # "This IS structured code. It's just randomly structured."
14 $purpose; # update per test, and include in print ok's !
33 print "#1\t:$foo: == 2\n";
34 if ($foo == 2) {print "ok 1\n";} else {print "not ok 1\n";}
38 print "#2\t:$foo: == 4\n";
39 if ($foo == 4) {print "ok 2\n";} else {print "not ok 2\n";}
41 $PERL = ($^O eq 'MSWin32') ? '.\perl' : ($^O eq 'MacOS') ? $^X : ($^O eq 'NetWare') ? 'perl' : './perl';
42 $CMD = qq[$PERL -e "goto foo;" 2>&1 ];
45 if ($x =~ /label/) {print "ok 3\n";} else {print "not ok 3\n";}
68 # does goto LABEL handle block contexts correctly?
69 $purpose = 'handles block contexts correctly (does scope-hopping)';
70 # note that this scope-hopping differs from last & next,
71 # which always go up-scope strictly.
81 print "ok 14 - $purpose\n";
86 print "ok 15 - $purpose\n";
91 # Does goto work correctly within a for(;;) loop?
92 # (BUG ID 20010309.004)
94 $purpose = 'goto inside a for(;;) loop body from inside the body';
98 label: print (defined $x?"ok ": "not ok ", "17 - $purpose\n")
101 # Does goto work correctly going *to* a for(;;) loop?
102 # (make sure it doesn't skip the initializer)
104 $purpose = 'goto a for(;;) loop, from outside (does initializer)';
106 FORL1: for($y="ok 18 - $purpose\n"; $z;) {print $y; goto TEST19}
107 ($y,$z) = ("not ok 18 - $purpose\n", 1);
110 # Even from within the loop?
112 $purpose = 'goto a for(;;) loop, from inside (does initializer)';
113 FORL2: for($y="ok 19 - $purpose\n"; 1;) {
118 ($y, $z) = ("not ok 19 - $purpose\n", 1);
122 # Does goto work correctly within a try block?
123 # (BUG ID 20000313.004)
124 $purpose = 'works correctly within a try block';
129 LABEL20: $ok = 1 if $variable;
131 print ($ok&&!$@ ? "ok 20" : "not ok 20", " - $purpose\n");
133 # And within an eval-string?
134 $purpose = 'works correctly within an eval string';
139 LABEL21: $ok = 1 if $variable;
141 print ($ok&&!$@ ? "ok" : "not ok", " 21 - $purpose\n");
144 # Test that goto works in nested eval-string
145 $purpose = 'works correctly in a nested eval string';
158 print ($ok ? "ok" : "not ok", " 22 - $purpose\n");
164 { goto A; A: $ok = 1 } continue { }
165 print "not " unless $ok;
166 print "ok 23 - #20357 goto inside /{ } continue { }/ loop\n";
169 { do { goto A; A: $ok = 1 } while $false }
170 print "not " unless $ok;
171 print "ok 24 - #20154 goto inside /do { } while ()/ loop\n";
174 foreach(1) { goto A; A: $ok = 1 } continue { };
175 print "not " unless $ok;
176 print "ok 25 - goto inside /foreach () { } continue { }/ loop\n";
180 A: { if ($false) { redo A; B: $ok = 1; redo A; } }
184 print "not " unless $ok;
185 print "ok 26 - #19061 loop label wiped away by goto\n";
188 for ($p=1;$p && goto A;$p=0) { A: $ok = 1 }
189 print "not " unless $ok;
190 print "ok 27 - weird case of goto and for(;;) loop\n";
193 # bug #9990 - don't prematurely free the CV we're &going to.
197 goto sub { $x; print "ok 28 - don't prematurely free CV\n" }
201 # bug #22181 - this used to coredump or make $x undefined, due to
202 # erroneous popping of the inner BLOCK context
204 for ($i=0; $i<2; $i++) {
208 print "not " if !defined $x || $x != 1;
210 print "ok 29 - goto in for(;;) with continuation\n";
212 # bug #22299 - goto in require doesn't find label
214 open my $f, ">goto01.pm" or die;
225 my $r = runperl(prog => 'use goto01; print qq[DONE\n]');
226 is($r, "OK\nDONE\n", "goto within use-d file");
229 # test for [perl #24108]
230 sub i_return_a_label {
231 print "ok 31 - i_return_a_label called\n";
232 return "returned_label";
234 eval { goto +i_return_a_label; };
236 returned_label : print "ok 32 - done to returned_label\n";
238 # [perl #29708] - goto &foo could leave foo() at depth two with
239 # @_ == PL_sv_undef, causing a coredump
244 'sub f { return if $d; $d=1; my $a=sub {goto &f}; &$a; f() } f(); print qq(ok\n)',
247 print "not " if $r ne "ok\n";
248 print "ok 33 - avoid pad without an \@_\n";
254 $purpose = 'eval "goto $x"';
255 print "ok 5 - $purpose\n";
257 # Test autoloading mechanism.
260 ($pack, $file, $line) = caller; # Should indicate original call stats.
261 $purpose = 'autoloading mechanism.';
262 print "@_ $pack $file $line" eq "1 2 3 main $FILE $LINE"
263 ? "ok 7 - $purpose\n"
264 : "not ok 7 - $purpose\n";
269 sub one { print "ok 6\n"; goto &two; print "not ok 6\n"; }
275 $LINE = __LINE__ + 1;
278 $purpose = 'goto NOWHERE sets $@';
280 eval { goto $wherever };
281 print $@ =~ /Can't find label NOWHERE/
282 ? "ok 8 - $purpose\n" : "not ok 8 - $purpose\n"; #'
284 # see if a modified @_ propagates
287 sub DESTROY { my $s = shift; print "ok $s->[0]\n"; }
288 sub show { print "# @_\nnot ok $_[0][0]\n" if @_ != 5; }
289 sub start { push @_, 1, "foo", {}; goto &show; }
290 for (9..11) { start(bless([$_]), 'bar'); }
297 sub AUTOLOAD { print @_ }
305 # test goto duplicated labels.
308 $purpose = "catch goto middle of foreach";
312 L4: # not outer scope
319 print ($@ =~ /Can't "goto" into the middle of a foreach loop/ #'
320 ? "ok" : "not ok", " 34 - $purpose\n");
323 # ambiguous label resolution (outer scope means endless loop!)
324 $purpose = "prefer same scope (loop body) to outer scope (loop entry)";
328 print $z == 10 ? "" : "not ", "ok 35 - $purpose\n";
332 print $z == 10 ? "" : "not ", "ok 36 - $purpose\n";
336 $purpose = "prefer this scope (block body) to outer scope (block entry)";
341 print $z == 10 ? "" : "not ", "ok 37 - $purpose\n";
345 print $z == 10 ? "" : "not ", "ok 38 - $purpose\n";
350 $purpose = "prefer this scope to inner scope";
353 L3: # not inner scope
357 print $z == 10 ? "": "not ", "ok 39 - $purpose\n";
361 print $z == 10 ? "" : "not ", "ok 40 - $purpose\n";
364 L4: # not outer scope
366 $purpose = "prefer this scope to inner,outer scopes";
369 L4: # not inner scope
373 print $z == 1 ? "": "not ", "ok 41 - $purpose\n";
377 print $z == 1 ? "": "not ", "ok 42 - $purpose\n";
381 $purpose = "same label, multiple times in same scope (choose 1st)";
385 L2: # without this, fails 1 (middle) out of 3 iterations
389 print $z == 10 ? "": "not ", "ok $tnum - $purpose\n";
391 goto L2 if $z == 10 and not $loop++;
396 # deep recursion with gotos eventually caused a stack reallocation
397 # which messed up buggy internals that didn't expect the stack to move
405 $_[0] ? +1 + recurse1($_[0] - 1) : 0
407 print "not " unless recurse1(500) == 500;
408 print "ok 46 - recursive goto &foo\n";