Commit | Line | Data |
---|---|---|
677fb045 NC |
1 | #!./perl -w |
2 | ||
3 | BEGIN { | |
4 | chdir 't' if -d 't'; | |
677fb045 | 5 | require './test.pl'; |
624c42e2 | 6 | set_up_inc('../lib'); |
677fb045 NC |
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" ); | |
b09ed995 | 379 | is( join(':', map $_ // 'undef', ((%h,$x) = (1,2,3,4))), '1:2:3:4:undef', |
b1babc51 RZ |
380 | 'hash+scalar assignment in list context' ); |
381 | ok( eq_hash( \%h, {1 => 2, 3 => 4} ), "correct hash" ); | |
382 | is( $x, undef, "correct scalar" ); | |
383 | ||
384 | is( scalar( (%h,%x) = (1,2,3,4)), 4, | |
385 | 'hash+hash assignment in scalar context' ); | |
386 | ok( eq_hash( \%h, {1 => 2, 3 => 4} ), "correct hash" ); | |
387 | ok( eq_hash( \%x, {} ), "correct hash" ); | |
388 | is( join(':', (%h,%x) = (1,2,3,4)), '1:2:3:4', | |
389 | 'hash+hash assignment in list context' ); | |
390 | ok( eq_hash( \%h, {1 => 2, 3 => 4} ), "correct hash" ); | |
391 | ok( eq_hash( \%x, {} ), "correct hash" ); | |
392 | ||
393 | is( scalar( (%h,@x) = (1,2,3,4)), 4, | |
394 | 'hash+array assignment in scalar context' ); | |
395 | ok( eq_hash( \%h, {1 => 2, 3 => 4} ), "correct hash" ); | |
396 | ok( eq_array( \@x, [] ), "correct array" ); | |
397 | is( join(':', (%h,@x) = (1,2,3,4)), '1:2:3:4', | |
398 | 'hash+hash assignment in list context' ); | |
399 | ok( eq_hash( \%h, {1 => 2, 3 => 4} ), "correct hash" ); | |
400 | ok( eq_array( \@x, [] ), "correct array" ); | |
401 | } | |
402 | ||
403 | # hash followed by more elements on LHS of list assignment | |
404 | # and duplicates on RHS | |
405 | # (%h, ...) = (1)x10; | |
406 | { | |
407 | my (%h, %x, @x, $x); | |
408 | is( scalar( (%h,$x) = (1,2,1,4)), 4, | |
409 | 'hash+scalar assignment in scalar context' ); | |
410 | ok( eq_hash( \%h, {1 => 4} ), "correct hash" ); | |
411 | is( $x, undef, "correct scalar" ); | |
b09ed995 | 412 | is( join(':', map $_ // 'undef', ((%h,$x) = (1,2,1,4))), '1:4:undef', |
b1babc51 RZ |
413 | 'hash+scalar assignment in list context' ); |
414 | ok( eq_hash( \%h, {1 => 4} ), "correct hash" ); | |
415 | is( $x, undef, "correct scalar" ); | |
416 | ||
417 | is( scalar( (%h,%x) = (1,2,1,4)), 4, | |
418 | 'hash+hash assignment in scalar context' ); | |
419 | ok( eq_hash( \%h, {1 => 4} ), "correct hash" ); | |
420 | ok( eq_hash( \%x, {} ), "correct hash" ); | |
421 | is( join(':', (%h,%x) = (1,2,1,4)), '1:4', | |
422 | 'hash+hash assignment in list context' ); | |
423 | ok( eq_hash( \%h, {1 => 4} ), "correct hash" ); | |
424 | ok( eq_hash( \%x, {} ), "correct hash" ); | |
425 | ||
426 | is( scalar( (%h,@x) = (1,2,1,4)), 4, | |
427 | 'hash+array assignment in scalar context' ); | |
428 | ok( eq_hash( \%h, {1 => 4} ), "correct hash" ); | |
429 | ok( eq_array( \@x, [] ), "correct array" ); | |
430 | is( join(':', (%h,@x) = (1,2,1,4)), '1:4', | |
431 | 'hash+hash assignment in list context' ); | |
432 | ok( eq_hash( \%h, {1 => 4} ), "correct hash" ); | |
433 | ok( eq_array( \@x, [] ), "correct array" ); | |
434 | } | |
435 | ||
436 | # hash followed by more elements on LHS of list assignment | |
437 | # and duplicates with odd number of elements on RHS | |
438 | # (%h, ...) = (1,2,3,4,1); | |
439 | { | |
3d2de69e | 440 | no warnings 'misc'; # suppress oddball warnings |
b1babc51 RZ |
441 | my (%h, %x, @x, $x); |
442 | is( scalar( (%h,$x) = (1,2,3,4,1)), 5, | |
443 | 'hash+scalar assignment in scalar context' ); | |
444 | ok( eq_hash( \%h, {1 => undef, 3 => 4} ), "correct hash" ); | |
445 | is( $x, undef, "correct scalar" ); | |
b09ed995 | 446 | is( join(':', map $_//'undef', (%h,$x) = (1,2,3,4,1)), '1:undef:3:4:undef', |
b1babc51 RZ |
447 | 'hash+scalar assignment in list context' ); |
448 | ok( eq_hash( \%h, {1 => undef, 3 => 4} ), "correct hash" ); | |
449 | is( $x, undef, "correct scalar" ); | |
450 | ||
451 | is( scalar( (%h,%x) = (1,2,3,4,1)), 5, | |
452 | 'hash+hash assignment in scalar context' ); | |
453 | ok( eq_hash( \%h, {1 => undef, 3 => 4} ), "correct hash" ); | |
454 | ok( eq_hash( \%x, {} ), "correct hash" ); | |
14da5e9e | 455 | is( join(':', map $_//'undef', (%h,%x) = (1,2,3,4,1)), '1:undef:3:4', |
b1babc51 RZ |
456 | 'hash+hash assignment in list context' ); |
457 | ok( eq_hash( \%h, {1 => undef, 3 => 4} ), "correct hash" ); | |
458 | ok( eq_hash( \%x, {} ), "correct hash" ); | |
459 | ||
460 | is( scalar( (%h,@x) = (1,2,3,4,1)), 5, | |
461 | 'hash+array assignment in scalar context' ); | |
462 | ok( eq_hash( \%h, {1 => undef, 3 => 4} ), "correct hash" ); | |
463 | ok( eq_array( \@x, [] ), "correct array" ); | |
14da5e9e | 464 | is( join(':', map $_//'undef', (%h,@x) = (1,2,3,4,1)), '1:undef:3:4', |
b1babc51 RZ |
465 | 'hash+hash assignment in list context' ); |
466 | ok( eq_hash( \%h, {1 => undef, 3 => 4} ), "correct hash" ); | |
467 | ok( eq_array( \@x, [] ), "correct array" ); | |
468 | } | |
469 | ||
470 | ||
471 | # not enough elements on rhs | |
472 | # ($x,$y,$z,...) = (1); | |
473 | { | |
474 | my ($x,$y,$z,@a,%h); | |
b09ed995 | 475 | is( join(':', map $_ // 'undef', (($x, $y, %h) = (1))), '1:undef', |
b1babc51 RZ |
476 | 'only assigned elements are returned in list context'); |
477 | is( join(':', ($x, $y, %h) = (1,1)), '1:1', | |
478 | 'only assigned elements are returned in list context'); | |
3d2de69e | 479 | no warnings 'misc'; # suppress oddball warnings |
14da5e9e | 480 | is( join(':', map $_//'undef', ($x, $y, %h) = (1,1,1)), '1:1:1:undef', |
b1babc51 RZ |
481 | 'only assigned elements are returned in list context'); |
482 | is( join(':', ($x, $y, %h) = (1,1,1,1)), '1:1:1:1', | |
483 | 'only assigned elements are returned in list context'); | |
14da5e9e | 484 | is( join(':', map $_//'undef', ($x, %h, $y) = (1,2,3,4)), |
b09ed995 | 485 | '1:2:3:4:undef:undef', |
b1babc51 | 486 | 'only assigned elements are returned in list context'); |
b09ed995 | 487 | is( join(':', map $_//'undef', ($x, $y, @h) = (1)), '1:undef', |
b1babc51 | 488 | 'only assigned elements are returned in list context'); |
b09ed995 | 489 | is( join(':', map $_//'undef', ($x, @h, $y) = (1,2,3,4)), '1:2:3:4:undef', |
b1babc51 RZ |
490 | 'only assigned elements are returned in list context'); |
491 | } | |
492 | ||
96e57460 RZ |
493 | # lvaluedness of list context |
494 | { | |
b1babc51 | 495 | my %h; my ($x, $y, $z); |
96e57460 RZ |
496 | $_++ foreach %h = (1,2,3,4); |
497 | ok( eq_hash( \%h, {1 => 3, 3 => 5} ), "aassign in list context returns lvalues" ); | |
498 | ||
499 | $_++ foreach %h = (1,2,1,4); | |
500 | ok( eq_hash( \%h, {1 => 5} ), "the same for assignment with duplicates" ); | |
501 | ||
96e57460 RZ |
502 | $_++ foreach ($x, %h) = (0,1,2,3,4); |
503 | is( $x, 1, "... and leading scalar" ); | |
504 | ok( eq_hash( \%h, {1 => 3, 3 => 5} ), "... scalar followed by hash" ); | |
505 | ||
b1babc51 RZ |
506 | { |
507 | no warnings 'misc'; | |
508 | $_++ foreach %h = (1,2,3); | |
509 | ok( eq_hash( \%h, {1 => 3, 3 => 1} ), "odd elements also lvalued" ); | |
510 | } | |
511 | ||
512 | $x = 0; | |
513 | $_++ foreach %h = ($x,$x); | |
514 | is($x, 0, "returned values are not aliased to RHS of the assignment operation"); | |
515 | ||
631dbaa2 FC |
516 | %h = (); |
517 | $x = 0; | |
518 | $_++ foreach sub :lvalue { %h = ($x,$x) }->(); | |
519 | is($x, 0, | |
520 | "returned values are not aliased to RHS of assignment in lvalue sub"); | |
521 | ||
b1babc51 | 522 | $_++ foreach ($x,$y,%h,$z) = (0); |
b09ed995 | 523 | ok( eq_array([$x,$y,%h,$z], [1,1,1]), "all assigned values are returned" ); |
b1babc51 RZ |
524 | |
525 | $_++ foreach ($x,$y,%h,$z) = (0,1); | |
b09ed995 | 526 | ok( eq_array([$x,$y,%h,$z], [1,2,1]), "all assigned values are returned" ); |
b1babc51 | 527 | |
3d2de69e | 528 | no warnings 'misc'; # suppress oddball warnings |
b1babc51 | 529 | $_++ foreach ($x,$y,%h,$z) = (0,1,2); |
b09ed995 | 530 | ok( eq_array([$x,$y,%h,$z], [1,2,2,1,1]), "all assigned values are returned" ); |
96e57460 RZ |
531 | } |
532 | ||
3e125ada | 533 |