Commit | Line | Data |
---|---|---|
8d063cd8 LW |
1 | #!./perl |
2 | ||
138b8230 GG |
3 | BEGIN { |
4 | require "test.pl"; | |
5 | } | |
6 | ||
5e17f11b | 7 | plan(25); |
8d063cd8 | 8 | |
138b8230 GG |
9 | my $tmpfile = tempfile(); |
10 | open (tmp,'>', $tmpfile) || die "Can't create Cmd_while.tmp."; | |
8d063cd8 LW |
11 | print tmp "tvi925\n"; |
12 | print tmp "tvi920\n"; | |
13 | print tmp "vt100\n"; | |
14 | print tmp "Amiga\n"; | |
15 | print tmp "paper\n"; | |
d1e4d418 | 16 | close tmp or die "Could not close: $!"; |
8d063cd8 LW |
17 | |
18 | # test "last" command | |
19 | ||
138b8230 | 20 | open(fh, $tmpfile) || die "Can't open Cmd_while.tmp."; |
8d063cd8 LW |
21 | while (<fh>) { |
22 | last if /vt100/; | |
23 | } | |
138b8230 | 24 | ok(!eof && /vt100/); |
8d063cd8 LW |
25 | |
26 | # test "next" command | |
27 | ||
28 | $bad = ''; | |
138b8230 | 29 | open(fh, $tmpfile) || die "Can't open Cmd_while.tmp."; |
8d063cd8 LW |
30 | while (<fh>) { |
31 | next if /vt100/; | |
32 | $bad = 1 if /vt100/; | |
33 | } | |
138b8230 | 34 | ok(eof && !/vt100/ && !$bad); |
8d063cd8 LW |
35 | |
36 | # test "redo" command | |
37 | ||
38 | $bad = ''; | |
138b8230 | 39 | open(fh,$tmpfile) || die "Can't open Cmd_while.tmp."; |
8d063cd8 LW |
40 | while (<fh>) { |
41 | if (s/vt100/VT100/g) { | |
42 | s/VT100/Vt100/g; | |
43 | redo; | |
44 | } | |
45 | $bad = 1 if /vt100/; | |
46 | $bad = 1 if /VT100/; | |
47 | } | |
138b8230 | 48 | ok(eof && !$bad); |
8d063cd8 LW |
49 | |
50 | # now do the same with a label and a continue block | |
51 | ||
52 | # test "last" command | |
53 | ||
54 | $badcont = ''; | |
138b8230 | 55 | open(fh,$tmpfile) || die "Can't open Cmd_while.tmp."; |
8d063cd8 LW |
56 | line: while (<fh>) { |
57 | if (/vt100/) {last line;} | |
58 | } continue { | |
59 | $badcont = 1 if /vt100/; | |
60 | } | |
138b8230 GG |
61 | ok(!eof && /vt100/); |
62 | ok(!$badcont); | |
8d063cd8 LW |
63 | |
64 | # test "next" command | |
65 | ||
66 | $bad = ''; | |
67 | $badcont = 1; | |
138b8230 | 68 | open(fh,$tmpfile) || die "Can't open Cmd_while.tmp."; |
8d063cd8 LW |
69 | entry: while (<fh>) { |
70 | next entry if /vt100/; | |
71 | $bad = 1 if /vt100/; | |
72 | } continue { | |
73 | $badcont = '' if /vt100/; | |
74 | } | |
138b8230 GG |
75 | ok(eof && !/vt100/ && !$bad); |
76 | ok(!$badcont); | |
8d063cd8 LW |
77 | |
78 | # test "redo" command | |
79 | ||
80 | $bad = ''; | |
81 | $badcont = ''; | |
138b8230 | 82 | open(fh,$tmpfile) || die "Can't open Cmd_while.tmp."; |
8d063cd8 LW |
83 | loop: while (<fh>) { |
84 | if (s/vt100/VT100/g) { | |
85 | s/VT100/Vt100/g; | |
86 | redo loop; | |
87 | } | |
88 | $bad = 1 if /vt100/; | |
89 | $bad = 1 if /VT100/; | |
90 | } continue { | |
91 | $badcont = 1 if /vt100/; | |
92 | } | |
138b8230 GG |
93 | ok(eof && !$bad); |
94 | ok(!$badcont); | |
8d063cd8 | 95 | |
bbad3607 | 96 | close(fh) || die "Can't close Cmd_while.tmp."; |
8d063cd8 LW |
97 | |
98 | $i = 9; | |
99 | { | |
100 | $i++; | |
101 | } | |
138b8230 | 102 | is($i, 10); |
2158dd9b GS |
103 | |
104 | # Check curpm is reset when jumping out of a scope | |
138b8230 | 105 | $i = 0; |
2158dd9b GS |
106 | 'abc' =~ /b/; |
107 | WHILE: | |
108 | while (1) { | |
109 | $i++; | |
138b8230 | 110 | is($` . $& . $', "abc"); |
2158dd9b GS |
111 | { # Localize changes to $` and friends |
112 | 'end' =~ /end/; | |
138b8230 GG |
113 | redo WHILE if $i == 1; |
114 | next WHILE if $i == 2; | |
115 | # 3 do a normal loop | |
116 | last WHILE if $i == 4; | |
2158dd9b GS |
117 | } |
118 | } | |
138b8230 | 119 | is($` . $& . $', "abc"); |
1ee98724 GS |
120 | |
121 | # check that scope cleanup happens right when there's a continue block | |
122 | { | |
123 | my $var = 16; | |
138b8230 | 124 | my (@got_var, @got_i); |
1ee98724 GS |
125 | while (my $i = ++$var) { |
126 | next if $i == 17; | |
127 | last if $i > 17; | |
128 | my $i = 0; | |
129 | } | |
130 | continue { | |
138b8230 | 131 | ($got_var, $got_i) = ($var, $i); |
1ee98724 | 132 | } |
138b8230 GG |
133 | is($got_var, 17); |
134 | is($got_i, 17); | |
1ee98724 | 135 | } |
87246558 GS |
136 | |
137 | { | |
138b8230 | 138 | my $got_l; |
87246558 GS |
139 | local $l = 18; |
140 | { | |
141 | local $l = 0 | |
142 | } | |
143 | continue { | |
138b8230 | 144 | $got_l = $l; |
87246558 | 145 | } |
138b8230 | 146 | is($got_l, 18); |
87246558 GS |
147 | } |
148 | ||
149 | { | |
138b8230 | 150 | my $got_l; |
87246558 GS |
151 | local $l = 19; |
152 | my $x = 0; | |
153 | while (!$x++) { | |
154 | local $l = 0 | |
155 | } | |
156 | continue { | |
138b8230 | 157 | $got_l = $l; |
87246558 | 158 | } |
138b8230 | 159 | is($got_l, $l); |
87246558 | 160 | } |
1ba6ee2b | 161 | |
1ba6ee2b | 162 | { |
138b8230 GG |
163 | my $ok = 1; |
164 | $i = 20; | |
1ba6ee2b GS |
165 | while (1) { |
166 | my $x; | |
138b8230 | 167 | $ok = 0 if defined $x; |
1ba6ee2b GS |
168 | if ($i == 21) { |
169 | next; | |
170 | } | |
171 | last; | |
172 | } | |
173 | continue { | |
138b8230 | 174 | ++$i; |
1ba6ee2b | 175 | } |
138b8230 | 176 | ok($ok); |
1ba6ee2b | 177 | } |
5e17f11b GG |
178 | |
179 | sub save_context { $_[0] = wantarray; $_[1] } | |
180 | ||
181 | { | |
182 | my $context = -1; | |
183 | my $p = sub { | |
184 | my $x = 1; | |
185 | while ($x--) { | |
186 | save_context($context, "foo"); | |
187 | } | |
188 | }; | |
189 | is(scalar($p->()), 0); | |
190 | is($context, undef, "last statement in while block has 'void' context"); | |
191 | } | |
192 | ||
193 | { | |
194 | my $context = -1; | |
195 | my $p = sub { | |
196 | my $x = 1; | |
197 | { | |
198 | save_context($context, "foo"); | |
199 | } | |
200 | }; | |
201 | is(scalar($p->()), "foo"); | |
202 | is($context, "", "last statement in block has 'scalar' context"); | |
203 | } | |
204 | ||
205 | { | |
206 | # test scope is cleaned | |
207 | my $i = 0; | |
208 | my @a; | |
209 | while ($i++ < 2) { | |
210 | my $x; | |
211 | push @a, \$x; | |
212 | } | |
213 | ok($a[0] ne $a[1]); | |
214 | } |