10 no warnings 'deprecated';
11 use vars qw($data $array $values $hash $errpat);
15 sub j { join(":",@_) }
19 # Hash insertion is currently unstable, in that
20 # %hash= %otherhash will not necessarily result in
21 # the same internal ordering of the data in the hash.
22 # For instance when keys collide the copy may not
23 # match the inserted order. So we declare one hash
24 # and then make all our copies from that, which should
25 # mean all the copies have the same internal structure.
27 # And these days, even if all that weren't true, we now
28 # per-hash randomize keys/values. So, we cant expect two
29 # hashes with the same internal structure to return the
30 # same thing at all. All we *can* expect is that keys()
31 # and values() use the same ordering.
34 BEGIN { # in BEGIN for "use constant ..." later
35 # values match keys here so we can easily check that keys(%hash) == values(%hash)
36 %base_hash= ( pi => 'pi', e => 'e', i => 'i' );
37 $array = [ qw(pi e i) ];
38 $values = [ qw(pi e i) ];
39 $hash = { %base_hash } ;
41 hash => { %base_hash },
49 hash => { %base_hash },
50 array => [@{$main::array}]
54 sub hash { no overloading; $_[0]->{hash} };
55 sub array { no overloading; $_[0]->{array} };
57 package Foo::Overload::Array;
58 sub new { return bless [ qw/foo bar/ ], shift }
59 use overload '@{}' => sub { $main::array }, fallback => 1;
61 package Foo::Overload::Hash;
62 sub new { return bless { qw/foo bar/ }, shift }
63 use overload '%{}' => sub { $main::hash }, fallback => 1;
65 package Foo::Overload::Both;
66 sub new { return bless { qw/foo bar/ }, shift }
67 use overload '%{}' => sub { $main::hash },
68 '@{}' => sub { $main::array }, fallback => 1;
70 package Foo::Overload::HashOnArray;
71 sub new { return bless [ qw/foo bar/ ], shift }
72 use overload '%{}' => sub { $main::hash }, fallback => 1;
74 package Foo::Overload::ArrayOnHash;
75 sub new { return bless { qw/foo bar/ }, shift }
76 use overload '@{}' => sub { $main::array }, fallback => 1;
80 use constant CONST_HASH => { %base_hash };
81 use constant CONST_ARRAY => [ @$array ];
83 my %a_hash = %base_hash;
84 my @an_array = @$array;
85 sub hash_sub { return \%a_hash; }
86 sub array_sub { return \@an_array; }
90 my ($empty, $h_expect, $a_expect, @tmp, @tmp2, $k, $v);
94 keys $hash; pass('Void: keys $hash;');
95 keys $data->{hash}; pass('Void: keys $data->{hash};');
96 keys CONST_HASH; pass('Void: keys CONST_HASH;');
97 keys CONST_HASH(); pass('Void: keys CONST_HASH();');
98 keys hash_sub(); pass('Void: keys hash_sub();');
99 keys hash_sub; pass('Void: keys hash_sub;');
100 keys $obj->hash; pass('Void: keys $obj->hash;');
101 keys $array; pass('Void: keys $array;');
102 keys $data->{array}; pass('Void: keys $data->{array};');
103 keys CONST_ARRAY; pass('Void: keys CONST_ARRAY;');
104 keys CONST_ARRAY(); pass('Void: keys CONST_ARRAY();');
105 keys array_sub; pass('Void: keys array_sub;');
106 keys array_sub(); pass('Void: keys array_sub();');
107 keys $obj->array; pass('Void: keys $obj->array;');
111 is(keys $hash ,3, 'Scalar: keys $hash');
112 is(keys $data->{hash} ,3, 'Scalar: keys $data->{hash}');
113 is(keys CONST_HASH ,3, 'Scalar: keys CONST_HASH');
114 is(keys CONST_HASH() ,3, 'Scalar: keys CONST_HASH()');
115 is(keys hash_sub ,3, 'Scalar: keys hash_sub');
116 is(keys hash_sub() ,3, 'Scalar: keys hash_sub()');
117 is(keys $obj->hash ,3, 'Scalar: keys $obj->hash');
118 is(keys $array ,3, 'Scalar: keys $array');
119 is(keys $data->{array} ,3, 'Scalar: keys $data->{array}');
120 is(keys CONST_ARRAY ,3, 'Scalar: keys CONST_ARRAY');
121 is(keys CONST_ARRAY() ,3, 'Scalar: keys CONST_ARRAY()');
122 is(keys array_sub ,3, 'Scalar: keys array_sub');
123 is(keys array_sub() ,3, 'Scalar: keys array_sub()');
124 is(keys $obj->array ,3, 'Scalar: keys $obj->array');
128 $h_expect = j(sort keys %base_hash);
129 $a_expect = j(keys @$array);
131 is(j(sort keys $hash) ,$h_expect, 'List: sort keys $hash');
132 is(j(sort keys $data->{hash}) ,$h_expect, 'List: sort keys $data->{hash}');
133 is(j(sort keys CONST_HASH) ,$h_expect, 'List: sort keys CONST_HASH');
134 is(j(sort keys CONST_HASH()) ,$h_expect, 'List: sort keys CONST_HASH()');
135 is(j(sort keys hash_sub) ,$h_expect, 'List: sort keys hash_sub');
136 is(j(sort keys hash_sub()) ,$h_expect, 'List: sort keys hash_sub()');
137 is(j(sort keys $obj->hash) ,$h_expect, 'List: sort keys $obj->hash');
139 is(j(keys $hash) ,j(values $hash), 'List: keys $hash == values $hash');
140 is(j(keys $data->{hash}) ,j(values $data->{hash}), 'List: keys $data->{hash} == values $data->{hash}');
141 is(j(keys CONST_HASH) ,j(values CONST_HASH), 'List: keys CONST_HASH == values CONST_HASH');
142 is(j(keys CONST_HASH()) ,j(values CONST_HASH()), 'List: keys CONST_HASH() == values CONST_HASH()');
143 is(j(keys hash_sub) ,j(values hash_sub), 'List: keys hash_sub == values hash_sub');
144 is(j(keys hash_sub()) ,j(values hash_sub()), 'List: keys hash_sub() == values hash_sub()');
145 is(j(keys $obj->hash) ,j(values $obj->hash), 'List: keys $obj->hash == values obj->hash');
147 is(j(keys $array) ,$a_expect, 'List: keys $array');
148 is(j(keys $data->{array}) ,$a_expect, 'List: keys $data->{array}');
149 is(j(keys CONST_ARRAY) ,$a_expect, 'List: keys CONST_ARRAY');
150 is(j(keys CONST_ARRAY()) ,$a_expect, 'List: keys CONST_ARRAY()');
151 is(j(keys array_sub) ,$a_expect, 'List: keys array_sub');
152 is(j(keys array_sub()) ,$a_expect, 'List: keys array_sub()');
153 is(j(keys $obj->array) ,$a_expect, 'List: keys $obj->array');
155 # Keys -- vivification
157 eval { keys $empty->{hash} };
159 'Vivify: $empty (after keys $empty->{hash}) is HASHREF');
160 ok(!defined $empty->{hash} , 'Vivify: $empty->{hash} is undef');
165 is scalar %_, '1/128', 'keys $hashref as lvalue';
166 eval 'keys \@_ = 65';
167 like $@, qr/Can't modify keys on reference in scalar assignment/,
168 'keys $arrayref as lvalue dies';
172 (?-x:Type of argument to keys on reference must be unblessed hashref or)
178 'Errors: keys undef throws error'
184 'Errors: keys $undef throws error'
187 is($empty, undef, 'keys $undef does not vivify $undef');
190 ok($@ =~ qr/Type of arg 1 to keys must be hash/,
191 'Errors: keys CONSTANT throws error'
196 'Errors: keys qr/foo/ throws error'
199 eval q"keys $hash qw/fo bar/";
200 ok($@ =~ qr/syntax error/,
201 'Errors: keys $hash, @stuff throws error'
202 ) or print "# Got: $@";
206 values $hash; pass('Void: values $hash;');
207 values $data->{hash}; pass('Void: values $data->{hash};');
208 values CONST_HASH; pass('Void: values CONST_HASH;');
209 values CONST_HASH(); pass('Void: values CONST_HASH();');
210 values hash_sub(); pass('Void: values hash_sub();');
211 values hash_sub; pass('Void: values hash_sub;');
212 values $obj->hash; pass('Void: values $obj->hash;');
213 values $array; pass('Void: values $array;');
214 values $data->{array}; pass('Void: values $data->{array};');
215 values CONST_ARRAY; pass('Void: values CONST_ARRAY;');
216 values CONST_ARRAY(); pass('Void: values CONST_ARRAY();');
217 values array_sub; pass('Void: values array_sub;');
218 values array_sub(); pass('Void: values array_sub();');
219 values $obj->array; pass('Void: values $obj->array;');
223 is(values $hash ,3, 'Scalar: values $hash');
224 is(values $data->{hash} ,3, 'Scalar: values $data->{hash}');
225 is(values CONST_HASH ,3, 'Scalar: values CONST_HASH');
226 is(values CONST_HASH() ,3, 'Scalar: values CONST_HASH()');
227 is(values hash_sub ,3, 'Scalar: values hash_sub');
228 is(values hash_sub() ,3, 'Scalar: values hash_sub()');
229 is(values $obj->hash ,3, 'Scalar: values $obj->hash');
230 is(values $array ,3, 'Scalar: values $array');
231 is(values $data->{array} ,3, 'Scalar: values $data->{array}');
232 is(values CONST_ARRAY ,3, 'Scalar: values CONST_ARRAY');
233 is(values CONST_ARRAY() ,3, 'Scalar: values CONST_ARRAY()');
234 is(values array_sub ,3, 'Scalar: values array_sub');
235 is(values array_sub() ,3, 'Scalar: values array_sub()');
236 is(values $obj->array ,3, 'Scalar: values $obj->array');
240 $h_expect = j(sort values %base_hash);
241 $a_expect = j(values @$array);
243 is(j(sort values $hash) ,$h_expect, 'List: sort values $hash');
244 is(j(sort values $data->{hash}) ,$h_expect, 'List: sort values $data->{hash}');
245 is(j(sort values CONST_HASH) ,$h_expect, 'List: sort values CONST_HASH');
246 is(j(sort values CONST_HASH()) ,$h_expect, 'List: sort values CONST_HASH()');
247 is(j(sort values hash_sub) ,$h_expect, 'List: sort values hash_sub');
248 is(j(sort values hash_sub()) ,$h_expect, 'List: sort values hash_sub()');
249 is(j(sort values $obj->hash) ,$h_expect, 'List: sort values $obj->hash');
251 is(j(values $hash) ,j(keys $hash), 'List: values $hash == keys $hash');
252 is(j(values $data->{hash}) ,j(keys $data->{hash}), 'List: values $data->{hash} == keys $data->{hash}');
253 is(j(values CONST_HASH) ,j(keys CONST_HASH), 'List: values CONST_HASH == keys CONST_HASH');
254 is(j(values CONST_HASH()) ,j(keys CONST_HASH()), 'List: values CONST_HASH() == keys CONST_HASH()');
255 is(j(values hash_sub) ,j(keys hash_sub), 'List: values hash_sub == keys hash_sub');
256 is(j(values hash_sub()) ,j(keys hash_sub()), 'List: values hash_sub() == keys hash_sub()');
257 is(j(values $obj->hash) ,j(keys $obj->hash), 'List: values $obj->hash == keys $obj->hash');
259 is(j(values $array) ,$a_expect, 'List: values $array');
260 is(j(values $data->{array}) ,$a_expect, 'List: values $data->{array}');
261 is(j(values CONST_ARRAY) ,$a_expect, 'List: values CONST_ARRAY');
262 is(j(values CONST_ARRAY()) ,$a_expect, 'List: values CONST_ARRAY()');
263 is(j(values array_sub) ,$a_expect, 'List: values array_sub');
264 is(j(values array_sub()) ,$a_expect, 'List: values array_sub()');
265 is(j(values $obj->array) ,$a_expect, 'List: values $obj->array');
267 # Values -- vivification
269 eval { values $empty->{hash} };
271 'Vivify: $empty (after values $empty->{hash}) is HASHREF');
272 ok(!defined $empty->{hash} , 'Vivify: $empty->{hash} is undef');
276 (?-x:Type of argument to values on reference must be unblessed hashref or)
282 'Errors: values undef throws error'
286 eval q"values $empty";
288 'Errors: values $undef throws error'
291 is($empty, undef, 'values $undef does not vivify $undef');
294 ok($@ =~ qr/Type of arg 1 to values must be hash/,
295 'Errors: values CONSTANT throws error'
298 eval "values qr/foo/";
300 'Errors: values qr/foo/ throws error'
303 eval q"values $hash qw/fo bar/";
304 ok($@ =~ qr/syntax error/,
305 'Errors: values $hash, @stuff throws error'
306 ) or print "# Got: $@";
310 each $hash; pass('Void: each $hash');
311 each $data->{hash}; pass('Void: each $data->{hash}');
312 each CONST_HASH; pass('Void: each CONST_HASH');
313 each CONST_HASH(); pass('Void: each CONST_HASH()');
314 each hash_sub(); pass('Void: each hash_sub()');
315 each hash_sub; pass('Void: each hash_sub');
316 each $obj->hash; pass('Void: each $obj->hash');
317 each $array; pass('Void: each $array');
318 each $data->{array}; pass('Void: each $data->{array}');
319 each CONST_ARRAY; pass('Void: each CONST_ARRAY');
320 each CONST_ARRAY(); pass('Void: each CONST_ARRAY()');
321 each array_sub; pass('Void: each array_sub');
322 each array_sub(); pass('Void: each array_sub()');
323 each $obj->array; pass('Void: each $obj->array');
344 @tmp=(); while(defined( $k = each $hash)) {push @tmp,$k}; is(j(@tmp),j(keys $hash), 'Scalar: each $hash');
345 @tmp=(); while(defined( $k = each $data->{hash})){push @tmp,$k}; is(j(@tmp),j(keys $data->{hash}), 'Scalar: each $data->{hash}');
346 @tmp=(); while(defined( $k = each CONST_HASH)){push @tmp,$k}; is(j(@tmp),j(keys CONST_HASH), 'Scalar: each CONST_HASH');
347 @tmp=(); while(defined( $k = each CONST_HASH())){push @tmp,$k}; is(j(@tmp),j(keys CONST_HASH()), 'Scalar: each CONST_HASH()');
348 @tmp=(); while(defined( $k = each hash_sub())){push @tmp,$k}; is(j(@tmp),j(keys hash_sub()), 'Scalar: each hash_sub()');
349 @tmp=(); while(defined( $k = each hash_sub)){push @tmp,$k}; is(j(@tmp),j(keys hash_sub), 'Scalar: each hash_sub');
350 @tmp=(); while(defined( $k = each $obj->hash)){push @tmp,$k}; is(j(@tmp),j(keys $obj->hash), 'Scalar: each $obj->hash');
351 @tmp=(); while(defined( $k = each $array)){push @tmp,$k}; is(j(@tmp),j(keys $array), 'Scalar: each $array');
352 @tmp=(); while(defined( $k = each $data->{array})){push @tmp,$k}; is(j(@tmp),j(keys $data->{array}), 'Scalar: each $data->{array}');
353 @tmp=(); while(defined( $k = each CONST_ARRAY)){push @tmp,$k}; is(j(@tmp),j(keys CONST_ARRAY), 'Scalar: each CONST_ARRAY');
354 @tmp=(); while(defined( $k = each CONST_ARRAY())){push @tmp,$k}; is(j(@tmp),j(keys CONST_ARRAY()), 'Scalar: each CONST_ARRAY()');
355 @tmp=(); while(defined( $k = each array_sub)){push @tmp,$k}; is(j(@tmp),j(keys array_sub), 'Scalar: each array_sub');
356 @tmp=(); while(defined( $k = each array_sub())){push @tmp,$k}; is(j(@tmp),j(keys array_sub()), 'Scalar: each array_sub()');
357 @tmp=(); while(defined( $k = each $obj->array)){push @tmp,$k}; is(j(@tmp),j(keys $obj->array), 'Scalar: each $obj->array');
361 @tmp=@tmp2=(); while(($k,$v) = each $hash) {push @tmp,$k; push @tmp2,$v}; is(j(@tmp,@tmp2),j(keys $hash, values $hash), 'List: each $hash');
362 @tmp=@tmp2=(); while(($k,$v) = each $data->{hash}){push @tmp,$k; push @tmp2,$v}; is(j(@tmp,@tmp2),j(keys $data->{hash}, values $data->{hash}), 'List: each $data->{hash}');
363 @tmp=@tmp2=(); while(($k,$v) = each CONST_HASH){push @tmp,$k; push @tmp2,$v}; is(j(@tmp,@tmp2),j(keys CONST_HASH, values CONST_HASH), 'List: each CONST_HASH');
364 @tmp=@tmp2=(); while(($k,$v) = each CONST_HASH()){push @tmp,$k; push @tmp2,$v}; is(j(@tmp,@tmp2),j(keys CONST_HASH(), values CONST_HASH()), 'List: each CONST_HASH()');
365 @tmp=@tmp2=(); while(($k,$v) = each hash_sub()){push @tmp,$k; push @tmp2,$v}; is(j(@tmp,@tmp2),j(keys hash_sub(), values hash_sub()), 'List: each hash_sub()');
366 @tmp=@tmp2=(); while(($k,$v) = each hash_sub){push @tmp,$k; push @tmp2,$v}; is(j(@tmp,@tmp2),j(keys hash_sub, values hash_sub), 'List: each hash_sub');
367 @tmp=@tmp2=(); while(($k,$v) = each $obj->hash){push @tmp,$k; push @tmp2,$v}; is(j(@tmp,@tmp2),j(keys $obj->hash, values $obj->hash), 'List: each $obj->hash');
368 @tmp=@tmp2=(); while(($k,$v) = each $array){push @tmp,$k; push @tmp2,$v}; is(j(@tmp,@tmp2),j(keys $array, values $array), 'List: each $array');
369 @tmp=@tmp2=(); while(($k,$v) = each $data->{array}){push @tmp,$k; push @tmp2,$v}; is(j(@tmp,@tmp2),j(keys $data->{array}, values $data->{array}), 'List: each $data->{array}');
370 @tmp=@tmp2=(); while(($k,$v) = each CONST_ARRAY){push @tmp,$k; push @tmp2,$v}; is(j(@tmp,@tmp2),j(keys CONST_ARRAY, values CONST_ARRAY), 'List: each CONST_ARRAY');
371 @tmp=@tmp2=(); while(($k,$v) = each CONST_ARRAY()){push @tmp,$k; push @tmp2,$v}; is(j(@tmp,@tmp2),j(keys CONST_ARRAY(), values CONST_ARRAY()), 'List: each CONST_ARRAY()');
372 @tmp=@tmp2=(); while(($k,$v) = each array_sub){push @tmp,$k; push @tmp2,$v}; is(j(@tmp,@tmp2),j(keys array_sub, values array_sub), 'List: each array_sub');
373 @tmp=@tmp2=(); while(($k,$v) = each array_sub()){push @tmp,$k; push @tmp2,$v}; is(j(@tmp,@tmp2),j(keys array_sub(), values array_sub()), 'List: each array_sub()');
374 @tmp=@tmp2=(); while(($k,$v) = each $obj->array){push @tmp,$k; push @tmp2,$v}; is(j(@tmp,@tmp2),j(keys $obj->array, values $obj->array), 'List: each $obj->array');
376 # Each -- vivification
378 eval { each $empty->{hash} };
380 'Vivify: $empty (after each $empty->{hash}) is HASHREF');
381 ok(!defined $empty->{hash} , 'Vivify: $empty->{hash} is undef');
385 (?-x:Type of argument to each on reference must be unblessed hashref or)
391 'Errors: each undef throws error'
397 'Errors: each $undef throws error'
400 is($empty, undef, 'each $undef does not vivify $undef');
403 ok($@ =~ qr/Type of arg 1 to each must be hash/,
404 'Errors: each CONSTANT throws error'
409 'Errors: each qr/foo/ throws error'
412 eval q"each $hash qw/foo bar/";
413 ok($@ =~ qr/syntax error/,
414 'Errors: each $hash, @stuff throws error'
415 ) or print "# Got: $@";
418 my $over_a = Foo::Overload::Array->new;
419 my $over_h = Foo::Overload::Hash->new;
420 my $over_b = Foo::Overload::Both->new;
421 my $over_h_a = Foo::Overload::HashOnArray->new;
422 my $over_a_h = Foo::Overload::ArrayOnHash->new;
426 local $SIG{__WARN__} = sub { $warn = shift };
429 (?-x:Type of argument to keys on reference must be unblessed hashref or)
433 eval { keys $over_a };
434 like($@, $errpat, "Overload: array dereference");
435 is($warn, '', "no warning issued"); $warn = '';
437 eval { keys $over_h };
438 like($@, $errpat, "Overload: hash dereference");
439 is($warn, '', "no warning issued"); $warn = '';
441 eval { keys $over_b };
442 like($@, $errpat, "Overload: ambiguous dereference (both)");
443 is($warn, '', "no warning issued"); $warn = '';
445 eval { keys $over_h_a };
446 like($@, $errpat, "Overload: ambiguous dereference");
447 is($warn, '', "no warning issued"); $warn = '';
449 eval { keys $over_a_h };
450 like($@, $errpat, "Overload: ambiguous dereference");
451 is($warn, '', "no warning issued"); $warn = '';