Commit | Line | Data |
---|---|---|
8d063cd8 LW |
1 | #!./perl |
2 | ||
8990e307 LW |
3 | # "This IS structured code. It's just randomly structured." |
4 | ||
a4f3a277 | 5 | print "1..22\n"; |
8d063cd8 | 6 | |
79072805 | 7 | while ($?) { |
8d063cd8 LW |
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 | ||
68dc0745 | 32 | $PERL = ($^O eq 'MSWin32') ? '.\perl' : './perl'; |
f0963acb | 33 | $CMD = qq[$PERL -e "goto foo;" 2>&1 ]; |
b39cdb36 | 34 | $x = `$CMD`; |
a0d0e21e | 35 | |
8d063cd8 | 36 | if ($x =~ /label/) {print "ok 3\n";} else {print "not ok 3\n";} |
79072805 LW |
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 { | |
8990e307 LW |
49 | $x = 'bypass'; |
50 | eval "goto $x"; | |
79072805 LW |
51 | } |
52 | ||
53 | &bar; | |
54 | exit; | |
8990e307 LW |
55 | |
56 | FINALE: | |
379c5dcc | 57 | print "ok 13\n"; |
2c15bef3 GS |
58 | |
59 | # does goto LABEL handle block contexts correctly? | |
60 | ||
61 | my $cond = 1; | |
62 | for (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 | } | |
78 | print "ok 16\n"; | |
36c66720 RH |
79 | |
80 | # Does goto work correctly within a for(;;) loop? | |
81 | # (BUG ID 20010309.004) | |
82 | ||
83 | for(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 | ||
92 | my ($z, $y) = (0); | |
93 | FORL1: for($y="ok 18\n"; $z;) {print $y; goto TEST19} | |
94 | ($y,$z) = ("not ok 18\n", 1); | |
95 | goto FORL1; | |
96 | ||
97 | # Even from within the loop? | |
98 | ||
99 | TEST19: $z = 0; | |
100 | FORL2: 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 | ||
9c5794fe RH |
109 | # Does goto work correctly within a try block? |
110 | # (BUG ID 20000313.004) | |
111 | ||
112 | my $ok = 0; | |
113 | eval { | |
114 | my $variable = 1; | |
115 | goto LABEL20; | |
116 | LABEL20: $ok = 1 if $variable; | |
117 | }; | |
118 | print ($ok&&!$@ ? "ok 20\n" : "not ok 20\n"); | |
119 | ||
120 | # And within an eval-string? | |
121 | ||
122 | ||
123 | $ok = 0; | |
124 | eval q{ | |
125 | my $variable = 1; | |
126 | goto LABEL21; | |
127 | LABEL21: $ok = 1 if $variable; | |
128 | }; | |
129 | print ($ok&&!$@ ? "ok 21\n" : "not ok 21\n"); | |
130 | ||
131 | ||
a4f3a277 RH |
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 | } | |
145 | print ($ok ? "ok 22\n" : "not ok 22\n"); | |
146 | ||
8990e307 LW |
147 | exit; |
148 | ||
149 | bypass: | |
79072805 | 150 | print "ok 5\n"; |
8990e307 LW |
151 | |
152 | # Test autoloading mechanism. | |
153 | ||
154 | sub 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 | ||
161 | sub one { | |
162 | eval <<'END'; | |
163 | sub one { print "ok 6\n"; goto &two; print "not ok 6\n"; } | |
164 | END | |
165 | goto &one; | |
166 | } | |
167 | ||
168 | $FILE = __FILE__; | |
169 | $LINE = __LINE__ + 1; | |
170 | &one(1,2,3); | |
171 | ||
172 | $wherever = NOWHERE; | |
173 | eval { goto $wherever }; | |
174 | print $@ =~ /Can't find label NOWHERE/ ? "ok 8\n" : "not ok 8\n"; | |
175 | ||
62b1ebc2 GS |
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 | ||
379c5dcc GS |
185 | sub auto { |
186 | goto &loadit; | |
187 | } | |
188 | ||
189 | sub AUTOLOAD { print @_ } | |
190 | ||
191 | auto("ok 12\n"); | |
192 | ||
8990e307 LW |
193 | $wherever = FINALE; |
194 | goto $wherever; |