This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Get t/uni/cache.t working under minitest
[perl5.git] / t / op / hashassign.t
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
11 plan tests => 309;
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
275 # now some tests for hash assignment in scalar and list context with
276 # duplicate keys [perl #24380],  [perl #31865]
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' );
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' );
283     is( scalar( %h = (1,2,1,3,1,4,1,5) ), 8,
284         'hash assignment in scalar context' );
285     is( scalar( ($x,%h) = (0,1,2,1,3,1,4,1,5) ), 9,
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 }
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 }
311
312 # [perl #76716] Hash assignment should not zap weak refs.
313 SKIP: {
314  skip_if_miniperl("no dynamic loading on miniperl, no Scalar::Util", 2);
315  my %tb;
316  require Scalar::Util;
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 }
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
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 {
442     no warnings 'misc'; # suppress oddball warnings
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
449     is( join(':', map $_//'undef', (%h,$x) = (1,2,3,4,1)), '1:undef:3:4',
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" );
458     is( join(':', map $_//'undef', (%h,%x) = (1,2,3,4,1)), '1:undef:3:4',
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" );
467     is( join(':', map $_//'undef', (%h,@x) = (1,2,3,4,1)), '1:undef:3:4',
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');
482     no warnings 'misc'; # suppress oddball warnings
483     is( join(':', map $_//'undef', ($x, $y, %h) = (1,1,1)), '1:1:1:undef',
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');
487     is( join(':', map $_//'undef', ($x, %h, $y) = (1,2,3,4)),
488         '1:2:3:4:undef',
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
496 # lvaluedness of list context
497 {
498     my %h; my ($x, $y, $z);
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
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
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
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
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
531     no warnings 'misc'; # suppress oddball warnings
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" );
534 }
535
536