Commit | Line | Data |
---|---|---|
677fb045 NC |
1 | #!./perl -w |
2 | ||
3 | BEGIN { | |
4 | chdir 't' if -d 't'; | |
5 | @INC = '../lib'; | |
6 | require './test.pl'; | |
7 | } | |
8 | ||
9 | # use strict; | |
10 | ||
631dbaa2 | 11 | plan tests => 309; |
677fb045 NC |
12 | |
13 | my @comma = ("key", "value"); | |
14 | ||
15 | # The peephole optimiser already knows that it should convert the string in | |
16 | # $foo{string} into a shared hash key scalar. It might be worth making the | |
17 | # tokeniser build the LHS of => as a shared hash key scalar too. | |
18 | # And so there's the possiblility of it going wrong | |
19 | # And going right on 8 bit but wrong on utf8 keys. | |
20 | # And really we should also try utf8 literals in {} and => in utf8.t | |
21 | ||
22 | # Some of these tests are (effectively) duplicated in each.t | |
23 | my %comma = @comma; | |
24 | ok (keys %comma == 1, 'keys on comma hash'); | |
25 | ok (values %comma == 1, 'values on comma hash'); | |
26 | # defeat any tokeniser or optimiser cunning | |
27 | my $key = 'ey'; | |
28 | is ($comma{"k" . $key}, "value", 'is key present? (unoptimised)'); | |
29 | # now with cunning: | |
30 | is ($comma{key}, "value", 'is key present? (maybe optimised)'); | |
31 | #tokeniser may treat => differently. | |
32 | my @temp = (key=>undef); | |
33 | is ($comma{$temp[0]}, "value", 'is key present? (using LHS of =>)'); | |
34 | ||
35 | @temp = %comma; | |
36 | ok (eq_array (\@comma, \@temp), 'list from comma hash'); | |
37 | ||
38 | @temp = each %comma; | |
39 | ok (eq_array (\@comma, \@temp), 'first each from comma hash'); | |
40 | @temp = each %comma; | |
41 | ok (eq_array ([], \@temp), 'last each from comma hash'); | |
42 | ||
43 | my %temp = %comma; | |
44 | ||
45 | ok (keys %temp == 1, 'keys on copy of comma hash'); | |
46 | ok (values %temp == 1, 'values on copy of comma hash'); | |
47 | is ($temp{'k' . $key}, "value", 'is key present? (unoptimised)'); | |
48 | # now with cunning: | |
49 | is ($temp{key}, "value", 'is key present? (maybe optimised)'); | |
50 | @temp = (key=>undef); | |
51 | is ($comma{$temp[0]}, "value", 'is key present? (using LHS of =>)'); | |
52 | ||
53 | @temp = %temp; | |
54 | ok (eq_array (\@temp, \@temp), 'list from copy of comma hash'); | |
55 | ||
56 | @temp = each %temp; | |
57 | ok (eq_array (\@temp, \@temp), 'first each from copy of comma hash'); | |
58 | @temp = each %temp; | |
59 | ok (eq_array ([], \@temp), 'last each from copy of comma hash'); | |
60 | ||
61 | my @arrow = (Key =>"Value"); | |
62 | ||
63 | my %arrow = @arrow; | |
64 | ok (keys %arrow == 1, 'keys on arrow hash'); | |
65 | ok (values %arrow == 1, 'values on arrow hash'); | |
66 | # defeat any tokeniser or optimiser cunning | |
67 | $key = 'ey'; | |
68 | is ($arrow{"K" . $key}, "Value", 'is key present? (unoptimised)'); | |
69 | # now with cunning: | |
70 | is ($arrow{Key}, "Value", 'is key present? (maybe optimised)'); | |
71 | #tokeniser may treat => differently. | |
72 | @temp = ('Key', undef); | |
73 | is ($arrow{$temp[0]}, "Value", 'is key present? (using LHS of =>)'); | |
74 | ||
75 | @temp = %arrow; | |
76 | ok (eq_array (\@arrow, \@temp), 'list from arrow hash'); | |
77 | ||
78 | @temp = each %arrow; | |
79 | ok (eq_array (\@arrow, \@temp), 'first each from arrow hash'); | |
80 | @temp = each %arrow; | |
81 | ok (eq_array ([], \@temp), 'last each from arrow hash'); | |
82 | ||
83 | %temp = %arrow; | |
84 | ||
85 | ok (keys %temp == 1, 'keys on copy of arrow hash'); | |
86 | ok (values %temp == 1, 'values on copy of arrow hash'); | |
87 | is ($temp{'K' . $key}, "Value", 'is key present? (unoptimised)'); | |
88 | # now with cunning: | |
89 | is ($temp{Key}, "Value", 'is key present? (maybe optimised)'); | |
90 | @temp = ('Key', undef); | |
91 | is ($arrow{$temp[0]}, "Value", 'is key present? (using LHS of =>)'); | |
92 | ||
93 | @temp = %temp; | |
94 | ok (eq_array (\@temp, \@temp), 'list from copy of arrow hash'); | |
95 | ||
96 | @temp = each %temp; | |
97 | ok (eq_array (\@temp, \@temp), 'first each from copy of arrow hash'); | |
98 | @temp = each %temp; | |
99 | ok (eq_array ([], \@temp), 'last each from copy of arrow hash'); | |
100 | ||
101 | my %direct = ('Camel', 2, 'Dromedary', 1); | |
102 | my %slow; | |
103 | $slow{Dromedary} = 1; | |
104 | $slow{Camel} = 2; | |
105 | ||
106 | ok (eq_hash (\%slow, \%direct), "direct list assignment to hash"); | |
107 | %direct = (Camel => 2, 'Dromedary' => 1); | |
108 | ok (eq_hash (\%slow, \%direct), "direct list assignment to hash using =>"); | |
109 | ||
110 | $slow{Llama} = 0; # A llama is not a camel :-) | |
111 | ok (!eq_hash (\%direct, \%slow), "different hashes should not be equal!"); | |
112 | ||
113 | my (%names, %names_copy); | |
114 | %names = ('$' => 'Scalar', '@' => 'Array', # Grr ' | |
115 | '%', 'Hash', '&', 'Code'); | |
116 | %names_copy = %names; | |
117 | ok (eq_hash (\%names, \%names_copy), "check we can copy our hash"); | |
118 | ||
119 | sub in { | |
120 | my %args = @_; | |
121 | return eq_hash (\%names, \%args); | |
122 | } | |
123 | ||
124 | ok (in (%names), "pass hash into a method"); | |
125 | ||
126 | sub in_method { | |
127 | my $self = shift; | |
128 | my %args = @_; | |
129 | return eq_hash (\%names, \%args); | |
130 | } | |
131 | ||
132 | ok (main->in_method (%names), "pass hash into a method"); | |
133 | ||
134 | sub out { | |
135 | return %names; | |
136 | } | |
137 | %names_copy = out (); | |
138 | ||
139 | ok (eq_hash (\%names, \%names_copy), "pass hash from a subroutine"); | |
140 | ||
141 | sub out_method { | |
142 | my $self = shift; | |
143 | return %names; | |
144 | } | |
145 | %names_copy = main->out_method (); | |
146 | ||
147 | ok (eq_hash (\%names, \%names_copy), "pass hash from a method"); | |
148 | ||
149 | sub in_out { | |
150 | my %args = @_; | |
151 | return %args; | |
152 | } | |
153 | %names_copy = in_out (%names); | |
154 | ||
155 | ok (eq_hash (\%names, \%names_copy), "pass hash to and from a subroutine"); | |
156 | ||
157 | sub in_out_method { | |
158 | my $self = shift; | |
159 | my %args = @_; | |
160 | return %args; | |
161 | } | |
162 | %names_copy = main->in_out_method (%names); | |
163 | ||
164 | ok (eq_hash (\%names, \%names_copy), "pass hash to and from a method"); | |
165 | ||
166 | my %names_copy2 = %names; | |
167 | ok (eq_hash (\%names, \%names_copy2), "check copy worked"); | |
168 | ||
169 | # This should get ignored. | |
170 | %names_copy = ('%', 'Associative Array', %names); | |
171 | ||
172 | ok (eq_hash (\%names, \%names_copy), "duplicates at the start of a list"); | |
173 | ||
174 | # This should not | |
175 | %names_copy = ('*', 'Typeglob', %names); | |
176 | ||
177 | $names_copy2{'*'} = 'Typeglob'; | |
178 | ok (eq_hash (\%names_copy, \%names_copy2), "duplicates at the end of a list"); | |
179 | ||
180 | %names_copy = ('%', 'Associative Array', '*', 'Endangered species', %names, | |
181 | '*', 'Typeglob',); | |
182 | ||
183 | ok (eq_hash (\%names_copy, \%names_copy2), "duplicates at both ends"); | |
184 | ||
185 | # And now UTF8 | |
186 | ||
187 | foreach my $chr (60, 200, 600, 6000, 60000) { | |
188 | # This little game may set a UTF8 flag internally. Or it may not. :-) | |
189 | my ($key, $value) = (chr ($chr) . "\x{ABCD}", "$chr\x{ABCD}"); | |
190 | chop ($key, $value); | |
191 | my @utf8c = ($key, $value); | |
192 | my %utf8c = @utf8c; | |
193 | ||
194 | ok (keys %utf8c == 1, 'keys on utf8 comma hash'); | |
195 | ok (values %utf8c == 1, 'values on utf8 comma hash'); | |
196 | # defeat any tokeniser or optimiser cunning | |
197 | is ($utf8c{"" . $key}, $value, 'is key present? (unoptimised)'); | |
198 | my $tempval = sprintf '$utf8c{"\x{%x}"}', $chr; | |
199 | is (eval $tempval, $value, "is key present? (maybe $tempval is optimised)"); | |
200 | $tempval = sprintf '@temp = ("\x{%x}" => undef)', $chr; | |
201 | eval $tempval or die "'$tempval' gave $@"; | |
202 | is ($utf8c{$temp[0]}, $value, 'is key present? (using LHS of $tempval)'); | |
203 | ||
204 | @temp = %utf8c; | |
205 | ok (eq_array (\@utf8c, \@temp), 'list from utf8 comma hash'); | |
206 | ||
207 | @temp = each %utf8c; | |
208 | ok (eq_array (\@utf8c, \@temp), 'first each from utf8 comma hash'); | |
209 | @temp = each %utf8c; | |
210 | ok (eq_array ([], \@temp), 'last each from utf8 comma hash'); | |
211 | ||
212 | %temp = %utf8c; | |
213 | ||
214 | ok (keys %temp == 1, 'keys on copy of utf8 comma hash'); | |
215 | ok (values %temp == 1, 'values on copy of utf8 comma hash'); | |
216 | is ($temp{"" . $key}, $value, 'is key present? (unoptimised)'); | |
217 | $tempval = sprintf '$temp{"\x{%x}"}', $chr; | |
218 | is (eval $tempval, $value, "is key present? (maybe $tempval is optimised)"); | |
219 | $tempval = sprintf '@temp = ("\x{%x}" => undef)', $chr; | |
220 | eval $tempval or die "'$tempval' gave $@"; | |
221 | is ($temp{$temp[0]}, $value, "is key present? (using LHS of $tempval)"); | |
222 | ||
223 | @temp = %temp; | |
224 | ok (eq_array (\@temp, \@temp), 'list from copy of utf8 comma hash'); | |
225 | ||
226 | @temp = each %temp; | |
227 | ok (eq_array (\@temp, \@temp), 'first each from copy of utf8 comma hash'); | |
228 | @temp = each %temp; | |
229 | ok (eq_array ([], \@temp), 'last each from copy of utf8 comma hash'); | |
230 | ||
231 | my $assign = sprintf '("\x{%x}" => "%d")', $chr, $chr; | |
232 | print "# $assign\n"; | |
233 | my (@utf8a) = eval $assign; | |
234 | ||
235 | my %utf8a = @utf8a; | |
236 | ok (keys %utf8a == 1, 'keys on utf8 arrow hash'); | |
237 | ok (values %utf8a == 1, 'values on utf8 arrow hash'); | |
238 | # defeat any tokeniser or optimiser cunning | |
239 | is ($utf8a{$key . ""}, $value, 'is key present? (unoptimised)'); | |
240 | $tempval = sprintf '$utf8a{"\x{%x}"}', $chr; | |
241 | is (eval $tempval, $value, "is key present? (maybe $tempval is optimised)"); | |
242 | $tempval = sprintf '@temp = ("\x{%x}" => undef)', $chr; | |
243 | eval $tempval or die "'$tempval' gave $@"; | |
244 | is ($utf8a{$temp[0]}, $value, "is key present? (using LHS of $tempval)"); | |
245 | ||
246 | @temp = %utf8a; | |
247 | ok (eq_array (\@utf8a, \@temp), 'list from utf8 arrow hash'); | |
248 | ||
249 | @temp = each %utf8a; | |
250 | ok (eq_array (\@utf8a, \@temp), 'first each from utf8 arrow hash'); | |
251 | @temp = each %utf8a; | |
252 | ok (eq_array ([], \@temp), 'last each from utf8 arrow hash'); | |
253 | ||
254 | %temp = %utf8a; | |
255 | ||
256 | ok (keys %temp == 1, 'keys on copy of utf8 arrow hash'); | |
257 | ok (values %temp == 1, 'values on copy of utf8 arrow hash'); | |
258 | is ($temp{'' . $key}, $value, 'is key present? (unoptimised)'); | |
259 | $tempval = sprintf '$temp{"\x{%x}"}', $chr; | |
260 | is (eval $tempval, $value, "is key present? (maybe $tempval is optimised)"); | |
261 | $tempval = sprintf '@temp = ("\x{%x}" => undef)', $chr; | |
262 | eval $tempval or die "'$tempval' gave $@"; | |
263 | is ($temp{$temp[0]}, $value, "is key present? (using LHS of $tempval)"); | |
264 | ||
265 | @temp = %temp; | |
266 | ok (eq_array (\@temp, \@temp), 'list from copy of utf8 arrow hash'); | |
267 | ||
268 | @temp = each %temp; | |
269 | ok (eq_array (\@temp, \@temp), 'first each from copy of utf8 arrow hash'); | |
270 | @temp = each %temp; | |
271 | ok (eq_array ([], \@temp), 'last each from copy of utf8 arrow hash'); | |
272 | ||
273 | } | |
274 | ||
ca65944e | 275 | # now some tests for hash assignment in scalar and list context with |
45960564 | 276 | # duplicate keys [perl #24380], [perl #31865] |
ca65944e RGS |
277 | { |
278 | my %h; my $x; my $ar; | |
279 | is( (join ':', %h = (1) x 8), '1:1', | |
280 | 'hash assignment in list context removes duplicates' ); | |
45960564 DM |
281 | is( (join ':', %h = qw(a 1 a 2 b 3 c 4 d 5 d 6)), 'a:2:b:3:c:4:d:6', |
282 | 'hash assignment in list context removes duplicates 2' ); | |
231cbeb2 | 283 | is( scalar( %h = (1,2,1,3,1,4,1,5) ), 8, |
ca65944e | 284 | 'hash assignment in scalar context' ); |
231cbeb2 | 285 | is( scalar( ($x,%h) = (0,1,2,1,3,1,4,1,5) ), 9, |
ca65944e RGS |
286 | 'scalar + hash assignment in scalar context' ); |
287 | $ar = [ %h = (1,2,1,3,1,4,1,5) ]; | |
288 | is( $#$ar, 1, 'hash assignment in list context' ); | |
289 | is( "@$ar", "1 5", '...gets the last values' ); | |
290 | $ar = [ ($x,%h) = (0,1,2,1,3,1,4,1,5) ]; | |
291 | is( $#$ar, 2, 'scalar + hash assignment in list context' ); | |
292 | is( "@$ar", "0 1 5", '...gets the last values' ); | |
293 | } | |
e3791f55 AS |
294 | |
295 | # test stringification of keys | |
296 | { | |
297 | no warnings 'once'; | |
298 | my @types = qw( SCALAR ARRAY HASH CODE GLOB); | |
299 | my @refs = ( \ do { my $x }, [], {}, sub {}, \ *x); | |
300 | my(%h, %expect); | |
301 | @h{@refs} = @types; | |
302 | @expect{map "$_", @refs} = @types; | |
303 | ok (eq_hash(\%h, \%expect), 'unblessed ref stringification'); | |
304 | ||
305 | bless $_ for @refs; | |
306 | %h = (); %expect = (); | |
307 | @h{@refs} = @types; | |
308 | @expect{map "$_", @refs} = @types; | |
309 | ok (eq_hash(\%h, \%expect), 'blessed ref stringification'); | |
310 | } | |
1c480c90 FC |
311 | |
312 | # [perl #76716] Hash assignment should not zap weak refs. | |
8c49cd2e NC |
313 | SKIP: { |
314 | skip_if_miniperl("no dynamic loading on miniperl, no Scalar::Util", 2); | |
1c480c90 | 315 | my %tb; |
8c49cd2e | 316 | require Scalar::Util; |
1c480c90 FC |
317 | Scalar::Util::weaken(my $p = \%tb); |
318 | %tb = (); | |
319 | is $p, \%tb, "hash assignment should not zap weak refs"; | |
320 | undef %tb; | |
321 | is $p, \%tb, "hash undef should not zap weak refs"; | |
322 | } | |
3e125ada RZ |
323 | |
324 | # test odd hash assignment warnings | |
325 | { | |
326 | my ($s, %h); | |
327 | warning_like(sub {%h = (1..3)}, qr/^Odd number of elements in hash assignment/); | |
328 | warning_like(sub {%h = ({})}, qr/^Reference found where even-sized list expected/); | |
329 | ||
330 | warning_like(sub { ($s, %h) = (1..4)}, qr/^Odd number of elements in hash assignment/); | |
331 | warning_like(sub { ($s, %h) = (1, {})}, qr/^Reference found where even-sized list expected/); | |
332 | } | |
333 | ||
334 | # hash assignment in scalar and list context with odd number of elements | |
335 | { | |
336 | no warnings 'misc', 'uninitialized'; | |
337 | my %h; my $x; | |
338 | is( join( ':', %h = (1..3)), '1:2:3:', | |
339 | 'odd hash assignment in list context' ); | |
340 | ok( eq_hash( \%h, {1 => 2, 3 => undef} ), "correct value stored" ); | |
341 | is( scalar( %h = (1..3) ), 3, | |
342 | 'odd hash assignment in scalar context' ); | |
343 | ok( eq_hash( \%h, {1 => 2, 3 => undef} ), "correct value stored" ); | |
344 | is( join(':', ($x,%h) = (0,1,2,3) ), '0:1:2:3:', | |
345 | 'scalar + odd hash assignment in list context' ); | |
346 | ok( eq_hash( \%h, {1 => 2, 3 => undef} ), "correct value stored" ); | |
347 | is( scalar( ($x,%h) = (0,1,2,3) ), 4, | |
348 | 'scalar + odd hash assignment in scalar context' ); | |
349 | ok( eq_hash( \%h, {1 => 2, 3 => undef} ), "correct value stored" ); | |
350 | } | |
351 | ||
352 | # hash assignment in scalar and list context with odd number of elements | |
353 | # and duplicates | |
354 | { | |
355 | no warnings 'misc', 'uninitialized'; | |
356 | my %h; my $x; | |
357 | is( (join ':', %h = (1,1,1)), '1:', | |
358 | 'odd hash assignment in list context with duplicates' ); | |
359 | ok( eq_hash( \%h, {1 => undef} ), "correct value stored" ); | |
360 | is( scalar(%h = (1,1,1)), 3, | |
361 | 'odd hash assignment in scalar context with duplicates' ); | |
362 | ok( eq_hash( \%h, {1 => undef} ), "correct value stored" ); | |
363 | is( join(':', ($x,%h) = (0,1,1,1) ), '0:1:', | |
364 | 'scalar + odd hash assignment in list context with duplicates' ); | |
365 | ok( eq_hash( \%h, {1 => undef} ), "correct value stored" ); | |
366 | is( scalar( ($x,%h) = (0,1,1,1) ), 4, | |
367 | 'scalar + odd hash assignment in scalar context with duplicates' ); | |
368 | ok( eq_hash( \%h, {1 => undef} ), "correct value stored" ); | |
369 | } | |
370 | ||
b1babc51 RZ |
371 | # hash followed by more elements on LHS of list assignment |
372 | # (%h, ...) = ...; | |
373 | { | |
374 | my (%h, %x, @x, $x); | |
375 | is( scalar( (%h,$x) = (1,2,3,4)), 4, | |
376 | 'hash+scalar assignment in scalar context' ); | |
377 | ok( eq_hash( \%h, {1 => 2, 3 => 4} ), "correct hash" ); | |
378 | is( $x, undef, "correct scalar" ); | |
379 | # this arguable, but this is how it works | |
380 | is( join(':', (%h,$x) = (1,2,3,4)), '1:2:3:4', | |
381 | 'hash+scalar assignment in list context' ); | |
382 | ok( eq_hash( \%h, {1 => 2, 3 => 4} ), "correct hash" ); | |
383 | is( $x, undef, "correct scalar" ); | |
384 | ||
385 | is( scalar( (%h,%x) = (1,2,3,4)), 4, | |
386 | 'hash+hash assignment in scalar context' ); | |
387 | ok( eq_hash( \%h, {1 => 2, 3 => 4} ), "correct hash" ); | |
388 | ok( eq_hash( \%x, {} ), "correct hash" ); | |
389 | is( join(':', (%h,%x) = (1,2,3,4)), '1:2:3:4', | |
390 | 'hash+hash assignment in list context' ); | |
391 | ok( eq_hash( \%h, {1 => 2, 3 => 4} ), "correct hash" ); | |
392 | ok( eq_hash( \%x, {} ), "correct hash" ); | |
393 | ||
394 | is( scalar( (%h,@x) = (1,2,3,4)), 4, | |
395 | 'hash+array assignment in scalar context' ); | |
396 | ok( eq_hash( \%h, {1 => 2, 3 => 4} ), "correct hash" ); | |
397 | ok( eq_array( \@x, [] ), "correct array" ); | |
398 | is( join(':', (%h,@x) = (1,2,3,4)), '1:2:3:4', | |
399 | 'hash+hash assignment in list context' ); | |
400 | ok( eq_hash( \%h, {1 => 2, 3 => 4} ), "correct hash" ); | |
401 | ok( eq_array( \@x, [] ), "correct array" ); | |
402 | } | |
403 | ||
404 | # hash followed by more elements on LHS of list assignment | |
405 | # and duplicates on RHS | |
406 | # (%h, ...) = (1)x10; | |
407 | { | |
408 | my (%h, %x, @x, $x); | |
409 | is( scalar( (%h,$x) = (1,2,1,4)), 4, | |
410 | 'hash+scalar assignment in scalar context' ); | |
411 | ok( eq_hash( \%h, {1 => 4} ), "correct hash" ); | |
412 | is( $x, undef, "correct scalar" ); | |
413 | # this arguable, but this is how it works | |
414 | is( join(':', (%h,$x) = (1,2,1,4)), '1:4', | |
415 | 'hash+scalar assignment in list context' ); | |
416 | ok( eq_hash( \%h, {1 => 4} ), "correct hash" ); | |
417 | is( $x, undef, "correct scalar" ); | |
418 | ||
419 | is( scalar( (%h,%x) = (1,2,1,4)), 4, | |
420 | 'hash+hash assignment in scalar context' ); | |
421 | ok( eq_hash( \%h, {1 => 4} ), "correct hash" ); | |
422 | ok( eq_hash( \%x, {} ), "correct hash" ); | |
423 | is( join(':', (%h,%x) = (1,2,1,4)), '1:4', | |
424 | 'hash+hash assignment in list context' ); | |
425 | ok( eq_hash( \%h, {1 => 4} ), "correct hash" ); | |
426 | ok( eq_hash( \%x, {} ), "correct hash" ); | |
427 | ||
428 | is( scalar( (%h,@x) = (1,2,1,4)), 4, | |
429 | 'hash+array assignment in scalar context' ); | |
430 | ok( eq_hash( \%h, {1 => 4} ), "correct hash" ); | |
431 | ok( eq_array( \@x, [] ), "correct array" ); | |
432 | is( join(':', (%h,@x) = (1,2,1,4)), '1:4', | |
433 | 'hash+hash assignment in list context' ); | |
434 | ok( eq_hash( \%h, {1 => 4} ), "correct hash" ); | |
435 | ok( eq_array( \@x, [] ), "correct array" ); | |
436 | } | |
437 | ||
438 | # hash followed by more elements on LHS of list assignment | |
439 | # and duplicates with odd number of elements on RHS | |
440 | # (%h, ...) = (1,2,3,4,1); | |
441 | { | |
3d2de69e | 442 | no warnings 'misc'; # suppress oddball warnings |
b1babc51 RZ |
443 | my (%h, %x, @x, $x); |
444 | is( scalar( (%h,$x) = (1,2,3,4,1)), 5, | |
445 | 'hash+scalar assignment in scalar context' ); | |
446 | ok( eq_hash( \%h, {1 => undef, 3 => 4} ), "correct hash" ); | |
447 | is( $x, undef, "correct scalar" ); | |
448 | # this arguable, but this is how it works | |
14da5e9e | 449 | is( join(':', map $_//'undef', (%h,$x) = (1,2,3,4,1)), '1:undef:3:4', |
b1babc51 RZ |
450 | 'hash+scalar assignment in list context' ); |
451 | ok( eq_hash( \%h, {1 => undef, 3 => 4} ), "correct hash" ); | |
452 | is( $x, undef, "correct scalar" ); | |
453 | ||
454 | is( scalar( (%h,%x) = (1,2,3,4,1)), 5, | |
455 | 'hash+hash assignment in scalar context' ); | |
456 | ok( eq_hash( \%h, {1 => undef, 3 => 4} ), "correct hash" ); | |
457 | ok( eq_hash( \%x, {} ), "correct hash" ); | |
14da5e9e | 458 | is( join(':', map $_//'undef', (%h,%x) = (1,2,3,4,1)), '1:undef:3:4', |
b1babc51 RZ |
459 | 'hash+hash assignment in list context' ); |
460 | ok( eq_hash( \%h, {1 => undef, 3 => 4} ), "correct hash" ); | |
461 | ok( eq_hash( \%x, {} ), "correct hash" ); | |
462 | ||
463 | is( scalar( (%h,@x) = (1,2,3,4,1)), 5, | |
464 | 'hash+array assignment in scalar context' ); | |
465 | ok( eq_hash( \%h, {1 => undef, 3 => 4} ), "correct hash" ); | |
466 | ok( eq_array( \@x, [] ), "correct array" ); | |
14da5e9e | 467 | is( join(':', map $_//'undef', (%h,@x) = (1,2,3,4,1)), '1:undef:3:4', |
b1babc51 RZ |
468 | 'hash+hash assignment in list context' ); |
469 | ok( eq_hash( \%h, {1 => undef, 3 => 4} ), "correct hash" ); | |
470 | ok( eq_array( \@x, [] ), "correct array" ); | |
471 | } | |
472 | ||
473 | ||
474 | # not enough elements on rhs | |
475 | # ($x,$y,$z,...) = (1); | |
476 | { | |
477 | my ($x,$y,$z,@a,%h); | |
478 | is( join(':', ($x, $y, %h) = (1)), '1', | |
479 | 'only assigned elements are returned in list context'); | |
480 | is( join(':', ($x, $y, %h) = (1,1)), '1:1', | |
481 | 'only assigned elements are returned in list context'); | |
3d2de69e | 482 | no warnings 'misc'; # suppress oddball warnings |
14da5e9e | 483 | is( join(':', map $_//'undef', ($x, $y, %h) = (1,1,1)), '1:1:1:undef', |
b1babc51 RZ |
484 | 'only assigned elements are returned in list context'); |
485 | is( join(':', ($x, $y, %h) = (1,1,1,1)), '1:1:1:1', | |
486 | 'only assigned elements are returned in list context'); | |
14da5e9e FC |
487 | is( join(':', map $_//'undef', ($x, %h, $y) = (1,2,3,4)), |
488 | '1:2:3:4:undef', | |
b1babc51 RZ |
489 | 'only assigned elements are returned in list context'); |
490 | is( join(':', ($x, $y, @h) = (1)), '1', | |
491 | 'only assigned elements are returned in list context'); | |
492 | is( join(':', ($x, @h, $y) = (1,2,3,4)), '1:2:3:4', | |
493 | 'only assigned elements are returned in list context'); | |
494 | } | |
495 | ||
96e57460 RZ |
496 | # lvaluedness of list context |
497 | { | |
b1babc51 | 498 | my %h; my ($x, $y, $z); |
96e57460 RZ |
499 | $_++ foreach %h = (1,2,3,4); |
500 | ok( eq_hash( \%h, {1 => 3, 3 => 5} ), "aassign in list context returns lvalues" ); | |
501 | ||
502 | $_++ foreach %h = (1,2,1,4); | |
503 | ok( eq_hash( \%h, {1 => 5} ), "the same for assignment with duplicates" ); | |
504 | ||
96e57460 RZ |
505 | $_++ foreach ($x, %h) = (0,1,2,3,4); |
506 | is( $x, 1, "... and leading scalar" ); | |
507 | ok( eq_hash( \%h, {1 => 3, 3 => 5} ), "... scalar followed by hash" ); | |
508 | ||
b1babc51 RZ |
509 | { |
510 | no warnings 'misc'; | |
511 | $_++ foreach %h = (1,2,3); | |
512 | ok( eq_hash( \%h, {1 => 3, 3 => 1} ), "odd elements also lvalued" ); | |
513 | } | |
514 | ||
515 | $x = 0; | |
516 | $_++ foreach %h = ($x,$x); | |
517 | is($x, 0, "returned values are not aliased to RHS of the assignment operation"); | |
518 | ||
631dbaa2 FC |
519 | %h = (); |
520 | $x = 0; | |
521 | $_++ foreach sub :lvalue { %h = ($x,$x) }->(); | |
522 | is($x, 0, | |
523 | "returned values are not aliased to RHS of assignment in lvalue sub"); | |
524 | ||
b1babc51 RZ |
525 | $_++ foreach ($x,$y,%h,$z) = (0); |
526 | ok( eq_array([$x,$y,%h,$z], [1,undef,undef]), "only assigned values are returned" ); | |
527 | ||
528 | $_++ foreach ($x,$y,%h,$z) = (0,1); | |
529 | ok( eq_array([$x,$y,%h,$z], [1,2,undef]), "only assigned values are returned" ); | |
530 | ||
3d2de69e | 531 | no warnings 'misc'; # suppress oddball warnings |
b1babc51 RZ |
532 | $_++ foreach ($x,$y,%h,$z) = (0,1,2); |
533 | ok( eq_array([$x,$y,%h,$z], [1,2,2,1,undef]), "only assigned values are returned" ); | |
96e57460 RZ |
534 | } |
535 | ||
3e125ada | 536 |