Commit | Line | Data |
8d063cd8 |
1 | #!./perl |
2 | |
8990e307 |
3 | # "This IS structured code. It's just randomly structured." |
4 | |
36c66720 |
5 | print "1..19\n"; |
8d063cd8 |
6 | |
79072805 |
7 | while ($?) { |
8d063cd8 |
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 |
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 |
49 | $x = 'bypass'; |
50 | eval "goto $x"; |
79072805 |
51 | } |
52 | |
53 | &bar; |
54 | exit; |
8990e307 |
55 | |
56 | FINALE: |
379c5dcc |
57 | print "ok 13\n"; |
2c15bef3 |
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 |
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 | |
8990e307 |
109 | exit; |
110 | |
111 | bypass: |
79072805 |
112 | print "ok 5\n"; |
8990e307 |
113 | |
114 | # Test autoloading mechanism. |
115 | |
116 | sub two { |
117 | ($pack, $file, $line) = caller; # Should indicate original call stats. |
118 | print "@_ $pack $file $line" eq "1 2 3 main $FILE $LINE" |
119 | ? "ok 7\n" |
120 | : "not ok 7\n"; |
121 | } |
122 | |
123 | sub one { |
124 | eval <<'END'; |
125 | sub one { print "ok 6\n"; goto &two; print "not ok 6\n"; } |
126 | END |
127 | goto &one; |
128 | } |
129 | |
130 | $FILE = __FILE__; |
131 | $LINE = __LINE__ + 1; |
132 | &one(1,2,3); |
133 | |
134 | $wherever = NOWHERE; |
135 | eval { goto $wherever }; |
136 | print $@ =~ /Can't find label NOWHERE/ ? "ok 8\n" : "not ok 8\n"; |
137 | |
62b1ebc2 |
138 | # see if a modified @_ propagates |
139 | { |
140 | package Foo; |
141 | sub DESTROY { my $s = shift; print "ok $s->[0]\n"; } |
142 | sub show { print "# @_\nnot ok $_[0][0]\n" if @_ != 5; } |
143 | sub start { push @_, 1, "foo", {}; goto &show; } |
144 | for (9..11) { start(bless([$_]), 'bar'); } |
145 | } |
146 | |
379c5dcc |
147 | sub auto { |
148 | goto &loadit; |
149 | } |
150 | |
151 | sub AUTOLOAD { print @_ } |
152 | |
153 | auto("ok 12\n"); |
154 | |
8990e307 |
155 | $wherever = FINALE; |
156 | goto $wherever; |