Commit | Line | Data |
8d063cd8 |
1 | #!./perl |
2 | |
8990e307 |
3 | # "This IS structured code. It's just randomly structured." |
4 | |
971ecbe6 |
5 | BEGIN { |
6 | chdir 't' if -d 't'; |
7 | @INC = qw(. ../lib); |
8 | } |
9 | |
10 | print "1..30\n"; |
11 | |
12 | require "test.pl"; |
8d063cd8 |
13 | |
79072805 |
14 | while ($?) { |
8d063cd8 |
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 | } |
26 | goto label1; |
27 | |
28 | $foo = 3; |
29 | |
30 | label2: |
31 | print "#1\t:$foo: == 2\n"; |
32 | if ($foo == 2) {print "ok 1\n";} else {print "not ok 1\n";} |
33 | goto label3; |
34 | |
35 | label4: |
36 | print "#2\t:$foo: == 4\n"; |
37 | if ($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 |
43 | if ($x =~ /label/) {print "ok 3\n";} else {print "not ok 3\n";} |
79072805 |
44 | |
45 | sub foo { |
46 | goto bar; |
47 | print "not ok 4\n"; |
48 | return; |
49 | bar: |
50 | print "ok 4\n"; |
51 | } |
52 | |
53 | &foo; |
54 | |
55 | sub bar { |
8990e307 |
56 | $x = 'bypass'; |
57 | eval "goto $x"; |
79072805 |
58 | } |
59 | |
60 | &bar; |
61 | exit; |
8990e307 |
62 | |
63 | FINALE: |
379c5dcc |
64 | print "ok 13\n"; |
2c15bef3 |
65 | |
66 | # does goto LABEL handle block contexts correctly? |
67 | |
68 | my $cond = 1; |
69 | for (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 | } |
85 | print "ok 16\n"; |
36c66720 |
86 | |
87 | # Does goto work correctly within a for(;;) loop? |
88 | # (BUG ID 20010309.004) |
89 | |
90 | for(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 | |
99 | my ($z, $y) = (0); |
100 | FORL1: for($y="ok 18\n"; $z;) {print $y; goto TEST19} |
101 | ($y,$z) = ("not ok 18\n", 1); |
102 | goto FORL1; |
103 | |
104 | # Even from within the loop? |
105 | |
106 | TEST19: $z = 0; |
107 | FORL2: 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 |
116 | # Does goto work correctly within a try block? |
117 | # (BUG ID 20000313.004) |
118 | |
119 | my $ok = 0; |
120 | eval { |
121 | my $variable = 1; |
122 | goto LABEL20; |
123 | LABEL20: $ok = 1 if $variable; |
124 | }; |
125 | print ($ok&&!$@ ? "ok 20\n" : "not ok 20\n"); |
126 | |
127 | # And within an eval-string? |
128 | |
129 | |
130 | $ok = 0; |
131 | eval q{ |
132 | my $variable = 1; |
133 | goto LABEL21; |
134 | LABEL21: $ok = 1 if $variable; |
135 | }; |
136 | print ($ok&&!$@ ? "ok 21\n" : "not ok 21\n"); |
137 | |
138 | |
a4f3a277 |
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 | } |
152 | print ($ok ? "ok 22\n" : "not ok 22\n"); |
153 | |
33d34e4c |
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 |
187 | # bug #9990 - don't prematurely free the CV we're &going to. |
188 | |
189 | sub f1 { |
190 | my $x; |
191 | goto sub { $x; print "ok 28 - don't prematurely free CV\n" } |
192 | } |
193 | f1(); |
194 | |
241416b8 |
195 | # bug #22181 - this used to coredump or make $x undefined, due to |
196 | # erroneous popping of the inner BLOCK context |
197 | |
198 | for ($i=0; $i<2; $i++) { |
199 | my $x = 1; |
200 | goto LABEL29; |
201 | LABEL29: |
202 | print "not " if !defined $x || $x != 1; |
203 | } |
204 | print "ok 29 - goto in for(;;) with continuation\n"; |
205 | |
971ecbe6 |
206 | # bug #22299 - goto in require doesn't find label |
207 | |
208 | open my $f, ">goto01.pm" or die; |
209 | print $f <<'EOT'; |
210 | package goto01; |
211 | goto YYY; |
212 | die; |
213 | YYY: print "OK\n"; |
214 | 1; |
215 | EOT |
216 | close $f; |
217 | |
218 | curr_test(30); |
219 | my $r = runperl(prog => 'use goto01; print qq[DONE\n]'); |
220 | is($r, "OK\nDONE\n", "goto within use-d file"); |
221 | unlink "goto01.pm"; |
222 | |
223 | |
8990e307 |
224 | exit; |
225 | |
226 | bypass: |
79072805 |
227 | print "ok 5\n"; |
8990e307 |
228 | |
229 | # Test autoloading mechanism. |
230 | |
231 | sub two { |
232 | ($pack, $file, $line) = caller; # Should indicate original call stats. |
233 | print "@_ $pack $file $line" eq "1 2 3 main $FILE $LINE" |
234 | ? "ok 7\n" |
235 | : "not ok 7\n"; |
236 | } |
237 | |
238 | sub one { |
239 | eval <<'END'; |
240 | sub one { print "ok 6\n"; goto &two; print "not ok 6\n"; } |
241 | END |
242 | goto &one; |
243 | } |
244 | |
245 | $FILE = __FILE__; |
246 | $LINE = __LINE__ + 1; |
247 | &one(1,2,3); |
248 | |
249 | $wherever = NOWHERE; |
250 | eval { goto $wherever }; |
251 | print $@ =~ /Can't find label NOWHERE/ ? "ok 8\n" : "not ok 8\n"; |
252 | |
62b1ebc2 |
253 | # see if a modified @_ propagates |
254 | { |
255 | package Foo; |
256 | sub DESTROY { my $s = shift; print "ok $s->[0]\n"; } |
257 | sub show { print "# @_\nnot ok $_[0][0]\n" if @_ != 5; } |
258 | sub start { push @_, 1, "foo", {}; goto &show; } |
259 | for (9..11) { start(bless([$_]), 'bar'); } |
260 | } |
261 | |
379c5dcc |
262 | sub auto { |
263 | goto &loadit; |
264 | } |
265 | |
266 | sub AUTOLOAD { print @_ } |
267 | |
268 | auto("ok 12\n"); |
269 | |
8990e307 |
270 | $wherever = FINALE; |
271 | goto $wherever; |