This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
hashassign.t: Suppress oddball warnings
[perl5.git] / t / op / hashassign.t
CommitLineData
677fb045
NC
1#!./perl -w
2
3BEGIN {
4 chdir 't' if -d 't';
5 @INC = '../lib';
6 require './test.pl';
7}
8
9# use strict;
10
631dbaa2 11plan tests => 309;
677fb045
NC
12
13my @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
23my %comma = @comma;
24ok (keys %comma == 1, 'keys on comma hash');
25ok (values %comma == 1, 'values on comma hash');
26# defeat any tokeniser or optimiser cunning
27my $key = 'ey';
28is ($comma{"k" . $key}, "value", 'is key present? (unoptimised)');
29# now with cunning:
30is ($comma{key}, "value", 'is key present? (maybe optimised)');
31#tokeniser may treat => differently.
32my @temp = (key=>undef);
33is ($comma{$temp[0]}, "value", 'is key present? (using LHS of =>)');
34
35@temp = %comma;
36ok (eq_array (\@comma, \@temp), 'list from comma hash');
37
38@temp = each %comma;
39ok (eq_array (\@comma, \@temp), 'first each from comma hash');
40@temp = each %comma;
41ok (eq_array ([], \@temp), 'last each from comma hash');
42
43my %temp = %comma;
44
45ok (keys %temp == 1, 'keys on copy of comma hash');
46ok (values %temp == 1, 'values on copy of comma hash');
47is ($temp{'k' . $key}, "value", 'is key present? (unoptimised)');
48# now with cunning:
49is ($temp{key}, "value", 'is key present? (maybe optimised)');
50@temp = (key=>undef);
51is ($comma{$temp[0]}, "value", 'is key present? (using LHS of =>)');
52
53@temp = %temp;
54ok (eq_array (\@temp, \@temp), 'list from copy of comma hash');
55
56@temp = each %temp;
57ok (eq_array (\@temp, \@temp), 'first each from copy of comma hash');
58@temp = each %temp;
59ok (eq_array ([], \@temp), 'last each from copy of comma hash');
60
61my @arrow = (Key =>"Value");
62
63my %arrow = @arrow;
64ok (keys %arrow == 1, 'keys on arrow hash');
65ok (values %arrow == 1, 'values on arrow hash');
66# defeat any tokeniser or optimiser cunning
67$key = 'ey';
68is ($arrow{"K" . $key}, "Value", 'is key present? (unoptimised)');
69# now with cunning:
70is ($arrow{Key}, "Value", 'is key present? (maybe optimised)');
71#tokeniser may treat => differently.
72@temp = ('Key', undef);
73is ($arrow{$temp[0]}, "Value", 'is key present? (using LHS of =>)');
74
75@temp = %arrow;
76ok (eq_array (\@arrow, \@temp), 'list from arrow hash');
77
78@temp = each %arrow;
79ok (eq_array (\@arrow, \@temp), 'first each from arrow hash');
80@temp = each %arrow;
81ok (eq_array ([], \@temp), 'last each from arrow hash');
82
83%temp = %arrow;
84
85ok (keys %temp == 1, 'keys on copy of arrow hash');
86ok (values %temp == 1, 'values on copy of arrow hash');
87is ($temp{'K' . $key}, "Value", 'is key present? (unoptimised)');
88# now with cunning:
89is ($temp{Key}, "Value", 'is key present? (maybe optimised)');
90@temp = ('Key', undef);
91is ($arrow{$temp[0]}, "Value", 'is key present? (using LHS of =>)');
92
93@temp = %temp;
94ok (eq_array (\@temp, \@temp), 'list from copy of arrow hash');
95
96@temp = each %temp;
97ok (eq_array (\@temp, \@temp), 'first each from copy of arrow hash');
98@temp = each %temp;
99ok (eq_array ([], \@temp), 'last each from copy of arrow hash');
100
101my %direct = ('Camel', 2, 'Dromedary', 1);
102my %slow;
103$slow{Dromedary} = 1;
104$slow{Camel} = 2;
105
106ok (eq_hash (\%slow, \%direct), "direct list assignment to hash");
107%direct = (Camel => 2, 'Dromedary' => 1);
108ok (eq_hash (\%slow, \%direct), "direct list assignment to hash using =>");
109
110$slow{Llama} = 0; # A llama is not a camel :-)
111ok (!eq_hash (\%direct, \%slow), "different hashes should not be equal!");
112
113my (%names, %names_copy);
114%names = ('$' => 'Scalar', '@' => 'Array', # Grr '
115 '%', 'Hash', '&', 'Code');
116%names_copy = %names;
117ok (eq_hash (\%names, \%names_copy), "check we can copy our hash");
118
119sub in {
120 my %args = @_;
121 return eq_hash (\%names, \%args);
122}
123
124ok (in (%names), "pass hash into a method");
125
126sub in_method {
127 my $self = shift;
128 my %args = @_;
129 return eq_hash (\%names, \%args);
130}
131
132ok (main->in_method (%names), "pass hash into a method");
133
134sub out {
135 return %names;
136}
137%names_copy = out ();
138
139ok (eq_hash (\%names, \%names_copy), "pass hash from a subroutine");
140
141sub out_method {
142 my $self = shift;
143 return %names;
144}
145%names_copy = main->out_method ();
146
147ok (eq_hash (\%names, \%names_copy), "pass hash from a method");
148
149sub in_out {
150 my %args = @_;
151 return %args;
152}
153%names_copy = in_out (%names);
154
155ok (eq_hash (\%names, \%names_copy), "pass hash to and from a subroutine");
156
157sub in_out_method {
158 my $self = shift;
159 my %args = @_;
160 return %args;
161}
162%names_copy = main->in_out_method (%names);
163
164ok (eq_hash (\%names, \%names_copy), "pass hash to and from a method");
165
166my %names_copy2 = %names;
167ok (eq_hash (\%names, \%names_copy2), "check copy worked");
168
169# This should get ignored.
170%names_copy = ('%', 'Associative Array', %names);
171
172ok (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';
178ok (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
183ok (eq_hash (\%names_copy, \%names_copy2), "duplicates at both ends");
184
185# And now UTF8
186
187foreach 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
FCR
311
312# [perl #76716] Hash assignment should not zap weak refs.
8c49cd2e
NC
313SKIP: {
314 skip_if_miniperl("no dynamic loading on miniperl, no Scalar::Util", 2);
1c480c90 315 my %tb;
8c49cd2e 316 require Scalar::Util;
1c480c90
FCR
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