Suppress a few compilation warnings in pp_hot.c.
[p5sagit/p5-mst-13.2.git] / t / op / goto.t
1 #!./perl
2
3 # "This IS structured code.  It's just randomly structured."
4
5 print "1..28\n";
6
7 while ($?) {
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
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
36 if ($x =~ /label/) {print "ok 3\n";} else {print "not ok 3\n";}
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 {
49     $x = 'bypass';
50     eval "goto $x";
51 }
52
53 &bar;
54 exit;
55
56 FINALE:
57 print "ok 13\n";
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";
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
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
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
147 {
148     my $false = 0;
149
150     $ok = 0;
151     { goto A; A: $ok = 1 } continue { }
152     print "not " unless $ok;
153     print "ok 23 - #20357 goto inside /{ } continue { }/ loop\n";
154
155     $ok = 0;
156     { do { goto A; A: $ok = 1 } while $false }
157     print "not " unless $ok;
158     print "ok 24 - #20154 goto inside /do { } while ()/ loop\n";
159
160     $ok = 0;
161     foreach(1) { goto A; A: $ok = 1 } continue { };
162     print "not " unless $ok;
163     print "ok 25 - goto inside /foreach () { } continue { }/ loop\n";
164
165     $ok = 0;
166     sub a {
167         A: { if ($false) { redo A; B: $ok = 1; redo A; } }
168         goto B unless $r++
169     }
170     a();
171     print "not " unless $ok;
172     print "ok 26 - #19061 loop label wiped away by goto\n";
173
174     $ok = 0;
175     for ($p=1;$p && goto A;$p=0) { A: $ok = 1 }
176     print "not " unless $ok;
177     print "ok 27 - weird case of goto and for(;;) loop\n";
178 }
179
180 # bug #9990 - don't prematurely free the CV we're &going to.
181
182 sub f1 {
183     my $x;
184     goto sub { $x; print "ok 28 - don't prematurely free CV\n" }
185 }
186 f1();
187
188 exit;
189
190 bypass:
191 print "ok 5\n";
192
193 # Test autoloading mechanism.
194
195 sub two {
196     ($pack, $file, $line) = caller;     # Should indicate original call stats.
197     print "@_ $pack $file $line" eq "1 2 3 main $FILE $LINE"
198         ? "ok 7\n"
199         : "not ok 7\n";
200 }
201
202 sub one {
203     eval <<'END';
204     sub one { print "ok 6\n"; goto &two; print "not ok 6\n"; }
205 END
206     goto &one;
207 }
208
209 $FILE = __FILE__;
210 $LINE = __LINE__ + 1;
211 &one(1,2,3);
212
213 $wherever = NOWHERE;
214 eval { goto $wherever };
215 print $@ =~ /Can't find label NOWHERE/ ? "ok 8\n" : "not ok 8\n";
216
217 # see if a modified @_ propagates
218 {
219   package Foo;
220   sub DESTROY   { my $s = shift; print "ok $s->[0]\n"; }
221   sub show      { print "# @_\nnot ok $_[0][0]\n" if @_ != 5; }
222   sub start     { push @_, 1, "foo", {}; goto &show; }
223   for (9..11)   { start(bless([$_]), 'bar'); }
224 }
225
226 sub auto {
227     goto &loadit;
228 }
229
230 sub AUTOLOAD { print @_ }
231
232 auto("ok 12\n");
233
234 $wherever = FINALE;
235 goto $wherever;