This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
2 patches: goto.t, B.pm/xs
[perl5.git] / t / op / goto.t
CommitLineData
8d063cd8
LW
1#!./perl
2
8990e307
LW
3# "This IS structured code. It's just randomly structured."
4
971ecbe6
DM
5BEGIN {
6 chdir 't' if -d 't';
7 @INC = qw(. ../lib);
8}
9
ff0adf16 10print "1..33\n";
971ecbe6
DM
11
12require "test.pl";
8d063cd8 13
79072805 14while ($?) {
8d063cd8
LW
15 $foo = 1;
16 label1:
17 $foo = 2;
18 goto label2;
19} continue {
20 $foo = 0;
21 goto label4;
22 label3:
23 $foo = 4;
24 goto label4;
25}
26goto label1;
27
28$foo = 3;
29
30label2:
31print "#1\t:$foo: == 2\n";
32if ($foo == 2) {print "ok 1\n";} else {print "not ok 1\n";}
33goto label3;
34
35label4:
36print "#2\t:$foo: == 4\n";
37if ($foo == 4) {print "ok 2\n";} else {print "not ok 2\n";}
38
2986a63f 39$PERL = ($^O eq 'MSWin32') ? '.\perl' : ($^O eq 'MacOS') ? $^X : ($^O eq 'NetWare') ? 'perl' : './perl';
f0963acb 40$CMD = qq[$PERL -e "goto foo;" 2>&1 ];
b39cdb36 41$x = `$CMD`;
a0d0e21e 42
8d063cd8 43if ($x =~ /label/) {print "ok 3\n";} else {print "not ok 3\n";}
79072805
LW
44
45sub foo {
46 goto bar;
47 print "not ok 4\n";
48 return;
49bar:
50 print "ok 4\n";
51}
52
53&foo;
54
55sub bar {
8990e307
LW
56 $x = 'bypass';
57 eval "goto $x";
79072805
LW
58}
59
60&bar;
61exit;
8990e307
LW
62
63FINALE:
379c5dcc 64print "ok 13\n";
2c15bef3
GS
65
66# does goto LABEL handle block contexts correctly?
67
68my $cond = 1;
69for (1) {
70 if ($cond == 1) {
71 $cond = 0;
72 goto OTHER;
73 }
74 elsif ($cond == 0) {
75 OTHER:
76 $cond = 2;
77 print "ok 14\n";
78 goto THIRD;
79 }
80 else {
81 THIRD:
82 print "ok 15\n";
83 }
84}
85print "ok 16\n";
36c66720
RH
86
87# Does goto work correctly within a for(;;) loop?
88# (BUG ID 20010309.004)
89
90for(my $i=0;!$i++;) {
91 my $x=1;
92 goto label;
93 label: print (defined $x?"ok ": "not ok ", "17\n")
94}
95
96# Does goto work correctly going *to* a for(;;) loop?
97# (make sure it doesn't skip the initializer)
98
99my ($z, $y) = (0);
100FORL1: for($y="ok 18\n"; $z;) {print $y; goto TEST19}
101($y,$z) = ("not ok 18\n", 1);
102goto FORL1;
103
104# Even from within the loop?
105
106TEST19: $z = 0;
107FORL2: for($y="ok 19\n"; 1;) {
108 if ($z) {
109 print $y;
110 last;
111 }
112 ($y, $z) = ("not ok 19\n", 1);
113 goto FORL2;
114}
115
9c5794fe
RH
116# Does goto work correctly within a try block?
117# (BUG ID 20000313.004)
118
119my $ok = 0;
120eval {
121 my $variable = 1;
122 goto LABEL20;
123 LABEL20: $ok = 1 if $variable;
124};
125print ($ok&&!$@ ? "ok 20\n" : "not ok 20\n");
126
127# And within an eval-string?
128
129
130$ok = 0;
131eval q{
132 my $variable = 1;
133 goto LABEL21;
134 LABEL21: $ok = 1 if $variable;
135};
136print ($ok&&!$@ ? "ok 21\n" : "not ok 21\n");
137
138
a4f3a277
RH
139# Test that goto works in nested eval-string
140$ok = 0;
141{eval q{
142 eval q{
143 goto LABEL22;
144 };
145 $ok = 0;
146 last;
147
148 LABEL22: $ok = 1;
149};
150$ok = 0 if $@;
151}
152print ($ok ? "ok 22\n" : "not ok 22\n");
153
33d34e4c
AE
154{
155 my $false = 0;
156
157 $ok = 0;
158 { goto A; A: $ok = 1 } continue { }
159 print "not " unless $ok;
160 print "ok 23 - #20357 goto inside /{ } continue { }/ loop\n";
161
162 $ok = 0;
163 { do { goto A; A: $ok = 1 } while $false }
164 print "not " unless $ok;
165 print "ok 24 - #20154 goto inside /do { } while ()/ loop\n";
166
167 $ok = 0;
168 foreach(1) { goto A; A: $ok = 1 } continue { };
169 print "not " unless $ok;
170 print "ok 25 - goto inside /foreach () { } continue { }/ loop\n";
171
172 $ok = 0;
173 sub a {
174 A: { if ($false) { redo A; B: $ok = 1; redo A; } }
175 goto B unless $r++
176 }
177 a();
178 print "not " unless $ok;
179 print "ok 26 - #19061 loop label wiped away by goto\n";
180
181 $ok = 0;
182 for ($p=1;$p && goto A;$p=0) { A: $ok = 1 }
183 print "not " unless $ok;
184 print "ok 27 - weird case of goto and for(;;) loop\n";
185}
186
5023d17a
DM
187# bug #9990 - don't prematurely free the CV we're &going to.
188
189sub f1 {
190 my $x;
191 goto sub { $x; print "ok 28 - don't prematurely free CV\n" }
192}
193f1();
194
241416b8
DM
195# bug #22181 - this used to coredump or make $x undefined, due to
196# erroneous popping of the inner BLOCK context
197
198for ($i=0; $i<2; $i++) {
199 my $x = 1;
200 goto LABEL29;
201 LABEL29:
202 print "not " if !defined $x || $x != 1;
203}
204print "ok 29 - goto in for(;;) with continuation\n";
205
971ecbe6
DM
206# bug #22299 - goto in require doesn't find label
207
208open my $f, ">goto01.pm" or die;
209print $f <<'EOT';
210package goto01;
211goto YYY;
212die;
213YYY: print "OK\n";
2141;
215EOT
216close $f;
217
218curr_test(30);
219my $r = runperl(prog => 'use goto01; print qq[DONE\n]');
220is($r, "OK\nDONE\n", "goto within use-d file");
221unlink "goto01.pm";
222
e3aba57a
RGS
223# test for [perl #24108]
224sub i_return_a_label {
225 print "ok 31 - i_return_a_label called\n";
226 return "returned_label";
227}
228eval { goto +i_return_a_label; };
229print "not ";
230returned_label : print "ok 32 - done to returned_label\n";
971ecbe6 231
ff0adf16
DM
232# [perl #29708] - goto &foo could leave foo() at depth two with
233# @_ == PL_sv_undef, causing a coredump
234
235
236my $r = runperl(
237 prog =>
238 'sub f { return if $d; $d=1; my $a=sub {goto &f}; &$a; f() } f(); print qq(ok\n)',
239 stderr => 1
240 );
241print "not " if $r ne "ok\n";
242print "ok 33 - avoid pad without an \@_\n";
243
244
8990e307
LW
245exit;
246
247bypass:
79072805 248print "ok 5\n";
8990e307
LW
249
250# Test autoloading mechanism.
251
252sub two {
253 ($pack, $file, $line) = caller; # Should indicate original call stats.
254 print "@_ $pack $file $line" eq "1 2 3 main $FILE $LINE"
255 ? "ok 7\n"
256 : "not ok 7\n";
257}
258
259sub one {
260 eval <<'END';
261 sub one { print "ok 6\n"; goto &two; print "not ok 6\n"; }
262END
263 goto &one;
264}
265
266$FILE = __FILE__;
267$LINE = __LINE__ + 1;
268&one(1,2,3);
269
270$wherever = NOWHERE;
271eval { goto $wherever };
272print $@ =~ /Can't find label NOWHERE/ ? "ok 8\n" : "not ok 8\n";
273
62b1ebc2
GS
274# see if a modified @_ propagates
275{
276 package Foo;
277 sub DESTROY { my $s = shift; print "ok $s->[0]\n"; }
278 sub show { print "# @_\nnot ok $_[0][0]\n" if @_ != 5; }
279 sub start { push @_, 1, "foo", {}; goto &show; }
280 for (9..11) { start(bless([$_]), 'bar'); }
281}
282
379c5dcc
GS
283sub auto {
284 goto &loadit;
285}
286
287sub AUTOLOAD { print @_ }
288
289auto("ok 12\n");
290
8990e307
LW
291$wherever = FINALE;
292goto $wherever;