Commit | Line | Data |
a687059c |
1 | #!./perl |
2 | |
1f5346dc |
3 | print "1..71\n"; |
a687059c |
4 | |
5 | sub foo { |
6 | local($a, $b) = @_; |
7 | local($c, $d); |
8 | $c = "ok 3\n"; |
9 | $d = "ok 4\n"; |
10 | { local($a,$c) = ("ok 9\n", "ok 10\n"); ($x, $y) = ($a, $c); } |
11 | print $a, $b; |
12 | $c . $d; |
13 | } |
14 | |
15 | $a = "ok 5\n"; |
16 | $b = "ok 6\n"; |
17 | $c = "ok 7\n"; |
18 | $d = "ok 8\n"; |
19 | |
93a17b20 |
20 | print &foo("ok 1\n","ok 2\n"); |
a687059c |
21 | |
22 | print $a,$b,$c,$d,$x,$y; |
23 | |
24 | # same thing, only with arrays and associative arrays |
25 | |
26 | sub foo2 { |
27 | local($a, @b) = @_; |
28 | local(@c, %d); |
29 | @c = "ok 13\n"; |
30 | $d{''} = "ok 14\n"; |
31 | { local($a,@c) = ("ok 19\n", "ok 20\n"); ($x, $y) = ($a, @c); } |
32 | print $a, @b; |
33 | $c[0] . $d{''}; |
34 | } |
35 | |
36 | $a = "ok 15\n"; |
37 | @b = "ok 16\n"; |
38 | @c = "ok 17\n"; |
39 | $d{''} = "ok 18\n"; |
40 | |
93a17b20 |
41 | print &foo2("ok 11\n","ok 12\n"); |
a687059c |
42 | |
43 | print $a,@b,@c,%d,$x,$y; |
706a304b |
44 | |
45 | eval 'local($$e)'; |
46 | print +($@ =~ /Can't localize through a reference/) ? "" : "not ", "ok 21\n"; |
47 | |
48 | eval 'local(@$e)'; |
49 | print +($@ =~ /Can't localize through a reference/) ? "" : "not ", "ok 22\n"; |
50 | |
51 | eval 'local(%$e)'; |
52 | print +($@ =~ /Can't localize through a reference/) ? "" : "not ", "ok 23\n"; |
85aff577 |
53 | |
161b7d16 |
54 | # Array and hash elements |
55 | |
56 | @a = ('a', 'b', 'c'); |
57 | { |
58 | local($a[1]) = 'foo'; |
59 | local($a[2]) = $a[2]; |
2bb40b7f |
60 | print +($a[1] eq 'foo') ? "" : "not ", "ok 24\n"; |
61 | print +($a[2] eq 'c') ? "" : "not ", "ok 25\n"; |
161b7d16 |
62 | undef @a; |
63 | } |
2bb40b7f |
64 | print +($a[1] eq 'b') ? "" : "not ", "ok 26\n"; |
65 | print +($a[2] eq 'c') ? "" : "not ", "ok 27\n"; |
66 | print +(!defined $a[0]) ? "" : "not ", "ok 28\n"; |
161b7d16 |
67 | |
68 | @a = ('a', 'b', 'c'); |
69 | { |
70 | local($a[1]) = "X"; |
71 | shift @a; |
72 | } |
2bb40b7f |
73 | print +($a[0].$a[1] eq "Xb") ? "" : "not ", "ok 29\n"; |
161b7d16 |
74 | |
75 | %h = ('a' => 1, 'b' => 2, 'c' => 3); |
76 | { |
77 | local($h{'a'}) = 'foo'; |
78 | local($h{'b'}) = $h{'b'}; |
2bb40b7f |
79 | print +($h{'a'} eq 'foo') ? "" : "not ", "ok 30\n"; |
80 | print +($h{'b'} == 2) ? "" : "not ", "ok 31\n"; |
161b7d16 |
81 | local($h{'c'}); |
82 | delete $h{'c'}; |
83 | } |
2bb40b7f |
84 | print +($h{'a'} == 1) ? "" : "not ", "ok 32\n"; |
85 | print +($h{'b'} == 2) ? "" : "not ", "ok 33\n"; |
86 | print +($h{'c'} == 3) ? "" : "not ", "ok 34\n"; |
87 | |
88 | # check for scope leakage |
89 | $a = 'outer'; |
90 | if (1) { local $a = 'inner' } |
91 | print +($a eq 'outer') ? "" : "not ", "ok 35\n"; |
92 | |
93 | # see if localization works when scope unwinds |
94 | local $m = 5; |
95 | eval { |
96 | for $m (6) { |
97 | local $m = 7; |
98 | die "bye"; |
99 | } |
100 | }; |
101 | print $m == 5 ? "" : "not ", "ok 36\n"; |
4e4c362e |
102 | |
103 | # see if localization works on tied arrays |
104 | { |
105 | package TA; |
106 | sub TIEARRAY { bless [], $_[0] } |
107 | sub STORE { print "# STORE [@_]\n"; $_[0]->[$_[1]] = $_[2] } |
108 | sub FETCH { my $v = $_[0]->[$_[1]]; print "# FETCH [@_=$v]\n"; $v } |
109 | sub CLEAR { print "# CLEAR [@_]\n"; @{$_[0]} = (); } |
110 | sub FETCHSIZE { scalar(@{$_[0]}) } |
111 | sub SHIFT { shift (@{$_[0]}) } |
112 | sub EXTEND {} |
113 | } |
114 | |
115 | tie @a, 'TA'; |
116 | @a = ('a', 'b', 'c'); |
117 | { |
118 | local($a[1]) = 'foo'; |
be6c24e0 |
119 | local($a[2]) = $a[2]; |
4e4c362e |
120 | print +($a[1] eq 'foo') ? "" : "not ", "ok 37\n"; |
be6c24e0 |
121 | print +($a[2] eq 'c') ? "" : "not ", "ok 38\n"; |
4e4c362e |
122 | @a = (); |
123 | } |
124 | print +($a[1] eq 'b') ? "" : "not ", "ok 39\n"; |
125 | print +($a[2] eq 'c') ? "" : "not ", "ok 40\n"; |
126 | print +(!defined $a[0]) ? "" : "not ", "ok 41\n"; |
127 | |
128 | { |
129 | package TH; |
130 | sub TIEHASH { bless {}, $_[0] } |
131 | sub STORE { print "# STORE [@_]\n"; $_[0]->{$_[1]} = $_[2] } |
132 | sub FETCH { my $v = $_[0]->{$_[1]}; print "# FETCH [@_=$v]\n"; $v } |
133 | sub DELETE { print "# DELETE [@_]\n"; delete $_[0]->{$_[1]}; } |
134 | sub CLEAR { print "# CLEAR [@_]\n"; %{$_[0]} = (); } |
135 | } |
136 | |
137 | # see if localization works on tied hashes |
138 | tie %h, 'TH'; |
139 | %h = ('a' => 1, 'b' => 2, 'c' => 3); |
140 | |
141 | { |
142 | local($h{'a'}) = 'foo'; |
be6c24e0 |
143 | local($h{'b'}) = $h{'b'}; |
4e4c362e |
144 | print +($h{'a'} eq 'foo') ? "" : "not ", "ok 42\n"; |
be6c24e0 |
145 | print +($h{'b'} == 2) ? "" : "not ", "ok 43\n"; |
4e4c362e |
146 | local($h{'c'}); |
147 | delete $h{'c'}; |
148 | } |
149 | print +($h{'a'} == 1) ? "" : "not ", "ok 44\n"; |
150 | print +($h{'b'} == 2) ? "" : "not ", "ok 45\n"; |
151 | print +($h{'c'} == 3) ? "" : "not ", "ok 46\n"; |
152 | |
153 | @a = ('a', 'b', 'c'); |
154 | { |
155 | local($a[1]) = "X"; |
156 | shift @a; |
157 | } |
158 | print +($a[0].$a[1] eq "Xb") ? "" : "not ", "ok 47\n"; |
159 | |
be6c24e0 |
160 | # now try the same for %SIG |
161 | |
162 | $SIG{TERM} = 'foo'; |
163 | $SIG{INT} = \&foo; |
164 | $SIG{__WARN__} = $SIG{INT}; |
165 | { |
166 | local($SIG{TERM}) = $SIG{TERM}; |
167 | local($SIG{INT}) = $SIG{INT}; |
168 | local($SIG{__WARN__}) = $SIG{__WARN__}; |
169 | print +($SIG{TERM} eq 'main::foo') ? "" : "not ", "ok 48\n"; |
170 | print +($SIG{INT} eq \&foo) ? "" : "not ", "ok 49\n"; |
171 | print +($SIG{__WARN__} eq \&foo) ? "" : "not ", "ok 50\n"; |
172 | local($SIG{INT}); |
173 | delete $SIG{__WARN__}; |
174 | } |
175 | print +($SIG{TERM} eq 'main::foo') ? "" : "not ", "ok 51\n"; |
176 | print +($SIG{INT} eq \&foo) ? "" : "not ", "ok 52\n"; |
177 | print +($SIG{__WARN__} eq \&foo) ? "" : "not ", "ok 53\n"; |
178 | |
179 | # and for %ENV |
180 | |
181 | $ENV{_X_} = 'a'; |
182 | $ENV{_Y_} = 'b'; |
183 | $ENV{_Z_} = 'c'; |
184 | { |
185 | local($ENV{_X_}) = 'foo'; |
186 | local($ENV{_Y_}) = $ENV{_Y_}; |
187 | print +($ENV{_X_} eq 'foo') ? "" : "not ", "ok 54\n"; |
188 | print +($ENV{_Y_} eq 'b') ? "" : "not ", "ok 55\n"; |
189 | local($ENV{_Z_}); |
190 | delete $ENV{_Z_}; |
191 | } |
192 | print +($ENV{_X_} eq 'a') ? "" : "not ", "ok 56\n"; |
193 | print +($ENV{_Y_} eq 'b') ? "" : "not ", "ok 57\n"; |
194 | print +($ENV{_Z_} eq 'c') ? "" : "not ", "ok 58\n"; |
195 | |
0214ae40 |
196 | # does implicit localization in foreach skip magic? |
197 | |
198 | $_ = "ok 59,ok 60,"; |
199 | my $iter = 0; |
200 | while (/(o.+?),/gc) { |
201 | print "$1\n"; |
202 | foreach (1..1) { $iter++ } |
203 | if ($iter > 2) { print "not ok 60\n"; last; } |
204 | } |
205 | |
206 | { |
207 | package UnderScore; |
208 | sub TIESCALAR { bless \my $self, shift } |
209 | sub FETCH { die "read \$_ forbidden" } |
210 | sub STORE { die "write \$_ forbidden" } |
211 | tie $_, __PACKAGE__; |
212 | my $t = 61; |
213 | my @tests = ( |
214 | "Nesting" => sub { print '#'; for (1..3) { print } |
215 | print "\n" }, 1, |
216 | "Reading" => sub { print }, 0, |
217 | "Matching" => sub { $x = /badness/ }, 0, |
218 | "Concat" => sub { $_ .= "a" }, 0, |
219 | "Chop" => sub { chop }, 0, |
220 | "Filetest" => sub { -x }, 0, |
221 | "Assignment" => sub { $_ = "Bad" }, 0, |
222 | # XXX whether next one should fail is debatable |
223 | "Local \$_" => sub { local $_ = 'ok?'; print }, 0, |
224 | "for local" => sub { for("#ok?\n"){ print } }, 1, |
225 | ); |
226 | while ( ($name, $code, $ok) = splice(@tests, 0, 3) ) { |
227 | print "# Testing $name\n"; |
228 | eval { &$code }; |
229 | print(($ok xor $@) ? "ok $t\n" : "not ok $t\n"); |
230 | ++$t; |
231 | } |
232 | untie $_; |
233 | } |
234 | |
1f5346dc |
235 | { |
236 | # BUG 20001205.22 |
237 | my %x; |
238 | $x{a} = 1; |
239 | { local $x{b} = 1; } |
240 | print "not " if exists $x{b}; |
241 | print "ok 70\n"; |
242 | { local @x{c,d,e}; } |
243 | print "not " if exists $x{c}; |
244 | print "ok 71\n"; |
245 | } |