10 no warnings 'deprecated';
11 use vars qw($data $array $values $hash $errpat);
15 sub j { join(":",@_) }
17 BEGIN { # in BEGIN for "use constant ..." later
18 $array = [ qw(pi e i) ];
19 $values = [ 3.14, 2.72, -1 ];
20 $hash = { pi => 3.14, e => 2.72, i => -1 } ;
30 hash => {%{$main::hash} },
31 array => [@{$main::array}]
35 sub hash { no overloading; $_[0]->{hash} };
36 sub array { no overloading; $_[0]->{array} };
38 package Foo::Overload::Array;
39 sub new { return bless [ qw/foo bar/ ], shift }
40 use overload '@{}' => sub { $main::array }, fallback => 1;
42 package Foo::Overload::Hash;
43 sub new { return bless { qw/foo bar/ }, shift }
44 use overload '%{}' => sub { $main::hash }, fallback => 1;
46 package Foo::Overload::Both;
47 sub new { return bless { qw/foo bar/ }, shift }
48 use overload '%{}' => sub { $main::hash },
49 '@{}' => sub { $main::array }, fallback => 1;
51 package Foo::Overload::HashOnArray;
52 sub new { return bless [ qw/foo bar/ ], shift }
53 use overload '%{}' => sub { $main::hash }, fallback => 1;
55 package Foo::Overload::ArrayOnHash;
56 sub new { return bless { qw/foo bar/ }, shift }
57 use overload '@{}' => sub { $main::array }, fallback => 1;
61 use constant CONST_HASH => { %$hash };
62 use constant CONST_ARRAY => [ @$array ];
65 my @an_array = @$array;
66 sub hash_sub { return \%a_hash; }
67 sub array_sub { return \@an_array; }
71 my ($empty, $h_expect, $a_expect, @tmp, @tmp2, $k, $v);
75 keys $hash; pass('Void: keys $hash;');
76 keys $data->{hash}; pass('Void: keys $data->{hash};');
77 keys CONST_HASH; pass('Void: keys CONST_HASH;');
78 keys CONST_HASH(); pass('Void: keys CONST_HASH();');
79 keys hash_sub(); pass('Void: keys hash_sub();');
80 keys hash_sub; pass('Void: keys hash_sub;');
81 keys $obj->hash; pass('Void: keys $obj->hash;');
82 keys $array; pass('Void: keys $array;');
83 keys $data->{array}; pass('Void: keys $data->{array};');
84 keys CONST_ARRAY; pass('Void: keys CONST_ARRAY;');
85 keys CONST_ARRAY(); pass('Void: keys CONST_ARRAY();');
86 keys array_sub; pass('Void: keys array_sub;');
87 keys array_sub(); pass('Void: keys array_sub();');
88 keys $obj->array; pass('Void: keys $obj->array;');
92 is(keys $hash ,3, 'Scalar: keys $hash');
93 is(keys $data->{hash} ,3, 'Scalar: keys $data->{hash}');
94 is(keys CONST_HASH ,3, 'Scalar: keys CONST_HASH');
95 is(keys CONST_HASH() ,3, 'Scalar: keys CONST_HASH()');
96 is(keys hash_sub ,3, 'Scalar: keys hash_sub');
97 is(keys hash_sub() ,3, 'Scalar: keys hash_sub()');
98 is(keys $obj->hash ,3, 'Scalar: keys $obj->hash');
99 is(keys $array ,3, 'Scalar: keys $array');
100 is(keys $data->{array} ,3, 'Scalar: keys $data->{array}');
101 is(keys CONST_ARRAY ,3, 'Scalar: keys CONST_ARRAY');
102 is(keys CONST_ARRAY() ,3, 'Scalar: keys CONST_ARRAY()');
103 is(keys array_sub ,3, 'Scalar: keys array_sub');
104 is(keys array_sub() ,3, 'Scalar: keys array_sub()');
105 is(keys $obj->array ,3, 'Scalar: keys $obj->array');
109 $h_expect = j(keys %$hash);
110 $a_expect = j(keys @$array);
112 is(j(keys $hash) ,$h_expect, 'List: keys $hash');
113 is(j(keys $data->{hash}) ,$h_expect, 'List: keys $data->{hash}');
114 is(j(keys CONST_HASH) ,$h_expect, 'List: keys CONST_HASH');
115 is(j(keys CONST_HASH()) ,$h_expect, 'List: keys CONST_HASH()');
116 is(j(keys hash_sub) ,$h_expect, 'List: keys hash_sub');
117 is(j(keys hash_sub()) ,$h_expect, 'List: keys hash_sub()');
118 is(j(keys $obj->hash) ,$h_expect, 'List: keys $obj->hash');
119 is(j(keys $array) ,$a_expect, 'List: keys $array');
120 is(j(keys $data->{array}) ,$a_expect, 'List: keys $data->{array}');
121 is(j(keys CONST_ARRAY) ,$a_expect, 'List: keys CONST_ARRAY');
122 is(j(keys CONST_ARRAY()) ,$a_expect, 'List: keys CONST_ARRAY()');
123 is(j(keys array_sub) ,$a_expect, 'List: keys array_sub');
124 is(j(keys array_sub()) ,$a_expect, 'List: keys array_sub()');
125 is(j(keys $obj->array) ,$a_expect, 'List: keys $obj->array');
127 # Keys -- vivification
129 eval { keys $empty->{hash} };
131 'Vivify: $empty (after keys $empty->{hash}) is HASHREF');
132 ok(!defined $empty->{hash} , 'Vivify: $empty->{hash} is undef');
137 is scalar %_, '1/128', 'keys $hashref as lvalue';
138 eval 'keys \@_ = 65';
139 like $@, qr/Can't modify keys on reference in scalar assignment/,
140 'keys $arrayref as lvalue dies';
144 (?-x:Type of argument to keys on reference must be unblessed hashref or)
150 'Errors: keys undef throws error'
156 'Errors: keys $undef throws error'
159 is($empty, undef, 'keys $undef does not vivify $undef');
162 ok($@ =~ qr/Type of arg 1 to keys must be hash/,
163 'Errors: keys CONSTANT throws error'
168 'Errors: keys qr/foo/ throws error'
171 eval "keys $hash qw/fo bar/";
172 ok($@ =~ qr/syntax error/,
173 'Errors: keys $hash, @stuff throws error'
174 ) or print "# Got: $@";
178 values $hash; pass('Void: values $hash;');
179 values $data->{hash}; pass('Void: values $data->{hash};');
180 values CONST_HASH; pass('Void: values CONST_HASH;');
181 values CONST_HASH(); pass('Void: values CONST_HASH();');
182 values hash_sub(); pass('Void: values hash_sub();');
183 values hash_sub; pass('Void: values hash_sub;');
184 values $obj->hash; pass('Void: values $obj->hash;');
185 values $array; pass('Void: values $array;');
186 values $data->{array}; pass('Void: values $data->{array};');
187 values CONST_ARRAY; pass('Void: values CONST_ARRAY;');
188 values CONST_ARRAY(); pass('Void: values CONST_ARRAY();');
189 values array_sub; pass('Void: values array_sub;');
190 values array_sub(); pass('Void: values array_sub();');
191 values $obj->array; pass('Void: values $obj->array;');
195 is(values $hash ,3, 'Scalar: values $hash');
196 is(values $data->{hash} ,3, 'Scalar: values $data->{hash}');
197 is(values CONST_HASH ,3, 'Scalar: values CONST_HASH');
198 is(values CONST_HASH() ,3, 'Scalar: values CONST_HASH()');
199 is(values hash_sub ,3, 'Scalar: values hash_sub');
200 is(values hash_sub() ,3, 'Scalar: values hash_sub()');
201 is(values $obj->hash ,3, 'Scalar: values $obj->hash');
202 is(values $array ,3, 'Scalar: values $array');
203 is(values $data->{array} ,3, 'Scalar: values $data->{array}');
204 is(values CONST_ARRAY ,3, 'Scalar: values CONST_ARRAY');
205 is(values CONST_ARRAY() ,3, 'Scalar: values CONST_ARRAY()');
206 is(values array_sub ,3, 'Scalar: values array_sub');
207 is(values array_sub() ,3, 'Scalar: values array_sub()');
208 is(values $obj->array ,3, 'Scalar: values $obj->array');
212 $h_expect = j(values %$hash);
213 $a_expect = j(values @$array);
215 is(j(values $hash) ,$h_expect, 'List: values $hash');
216 is(j(values $data->{hash}) ,$h_expect, 'List: values $data->{hash}');
217 is(j(values CONST_HASH) ,$h_expect, 'List: values CONST_HASH');
218 is(j(values CONST_HASH()) ,$h_expect, 'List: values CONST_HASH()');
219 is(j(values hash_sub) ,$h_expect, 'List: values hash_sub');
220 is(j(values hash_sub()) ,$h_expect, 'List: values hash_sub()');
221 is(j(values $obj->hash) ,$h_expect, 'List: values $obj->hash');
222 is(j(values $array) ,$a_expect, 'List: values $array');
223 is(j(values $data->{array}) ,$a_expect, 'List: values $data->{array}');
224 is(j(values CONST_ARRAY) ,$a_expect, 'List: values CONST_ARRAY');
225 is(j(values CONST_ARRAY()) ,$a_expect, 'List: values CONST_ARRAY()');
226 is(j(values array_sub) ,$a_expect, 'List: values array_sub');
227 is(j(values array_sub()) ,$a_expect, 'List: values array_sub()');
228 is(j(values $obj->array) ,$a_expect, 'List: values $obj->array');
230 # Values -- vivification
232 eval { values $empty->{hash} };
234 'Vivify: $empty (after values $empty->{hash}) is HASHREF');
235 ok(!defined $empty->{hash} , 'Vivify: $empty->{hash} is undef');
239 (?-x:Type of argument to values on reference must be unblessed hashref or)
245 'Errors: values undef throws error'
249 eval q"values $empty";
251 'Errors: values $undef throws error'
254 is($empty, undef, 'values $undef does not vivify $undef');
257 ok($@ =~ qr/Type of arg 1 to values must be hash/,
258 'Errors: values CONSTANT throws error'
261 eval "values qr/foo/";
263 'Errors: values qr/foo/ throws error'
266 eval "values $hash qw/fo bar/";
267 ok($@ =~ qr/syntax error/,
268 'Errors: values $hash, @stuff throws error'
269 ) or print "# Got: $@";
273 each $hash; pass('Void: each $hash');
274 each $data->{hash}; pass('Void: each $data->{hash}');
275 each CONST_HASH; pass('Void: each CONST_HASH');
276 each CONST_HASH(); pass('Void: each CONST_HASH()');
277 each hash_sub(); pass('Void: each hash_sub()');
278 each hash_sub; pass('Void: each hash_sub');
279 each $obj->hash; pass('Void: each $obj->hash');
280 each $array; pass('Void: each $array');
281 each $data->{array}; pass('Void: each $data->{array}');
282 each CONST_ARRAY; pass('Void: each CONST_ARRAY');
283 each CONST_ARRAY(); pass('Void: each CONST_ARRAY()');
284 each array_sub; pass('Void: each array_sub');
285 each array_sub(); pass('Void: each array_sub()');
286 each $obj->array; pass('Void: each $obj->array');
307 @tmp=(); while(defined( $k = each $hash)) {push @tmp,$k}; is(j(@tmp),j(keys $hash), 'Scalar: each $hash');
308 @tmp=(); while(defined( $k = each $data->{hash})){push @tmp,$k}; is(j(@tmp),j(keys $data->{hash}), 'Scalar: each $data->{hash}');
309 @tmp=(); while(defined( $k = each CONST_HASH)){push @tmp,$k}; is(j(@tmp),j(keys CONST_HASH), 'Scalar: each CONST_HASH');
310 @tmp=(); while(defined( $k = each CONST_HASH())){push @tmp,$k}; is(j(@tmp),j(keys CONST_HASH()), 'Scalar: each CONST_HASH()');
311 @tmp=(); while(defined( $k = each hash_sub())){push @tmp,$k}; is(j(@tmp),j(keys hash_sub()), 'Scalar: each hash_sub()');
312 @tmp=(); while(defined( $k = each hash_sub)){push @tmp,$k}; is(j(@tmp),j(keys hash_sub), 'Scalar: each hash_sub');
313 @tmp=(); while(defined( $k = each $obj->hash)){push @tmp,$k}; is(j(@tmp),j(keys $obj->hash), 'Scalar: each $obj->hash');
314 @tmp=(); while(defined( $k = each $array)){push @tmp,$k}; is(j(@tmp),j(keys $array), 'Scalar: each $array');
315 @tmp=(); while(defined( $k = each $data->{array})){push @tmp,$k}; is(j(@tmp),j(keys $data->{array}), 'Scalar: each $data->{array}');
316 @tmp=(); while(defined( $k = each CONST_ARRAY)){push @tmp,$k}; is(j(@tmp),j(keys CONST_ARRAY), 'Scalar: each CONST_ARRAY');
317 @tmp=(); while(defined( $k = each CONST_ARRAY())){push @tmp,$k}; is(j(@tmp),j(keys CONST_ARRAY()), 'Scalar: each CONST_ARRAY()');
318 @tmp=(); while(defined( $k = each array_sub)){push @tmp,$k}; is(j(@tmp),j(keys array_sub), 'Scalar: each array_sub');
319 @tmp=(); while(defined( $k = each array_sub())){push @tmp,$k}; is(j(@tmp),j(keys array_sub()), 'Scalar: each array_sub()');
320 @tmp=(); while(defined( $k = each $obj->array)){push @tmp,$k}; is(j(@tmp),j(keys $obj->array), 'Scalar: each $obj->array');
324 @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');
325 @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}');
326 @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');
327 @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()');
328 @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()');
329 @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');
330 @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');
331 @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');
332 @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}');
333 @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');
334 @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()');
335 @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');
336 @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()');
337 @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');
339 # Each -- vivification
341 eval { each $empty->{hash} };
343 'Vivify: $empty (after each $empty->{hash}) is HASHREF');
344 ok(!defined $empty->{hash} , 'Vivify: $empty->{hash} is undef');
348 (?-x:Type of argument to each on reference must be unblessed hashref or)
354 'Errors: each undef throws error'
360 'Errors: each $undef throws error'
363 is($empty, undef, 'each $undef does not vivify $undef');
366 ok($@ =~ qr/Type of arg 1 to each must be hash/,
367 'Errors: each CONSTANT throws error'
372 'Errors: each qr/foo/ throws error'
375 eval "each $hash qw/foo bar/";
376 ok($@ =~ qr/syntax error/,
377 'Errors: each $hash, @stuff throws error'
378 ) or print "# Got: $@";
381 my $over_a = Foo::Overload::Array->new;
382 my $over_h = Foo::Overload::Hash->new;
383 my $over_b = Foo::Overload::Both->new;
384 my $over_h_a = Foo::Overload::HashOnArray->new;
385 my $over_a_h = Foo::Overload::ArrayOnHash->new;
389 local $SIG{__WARN__} = sub { $warn = shift };
392 (?-x:Type of argument to keys on reference must be unblessed hashref or)
396 eval { keys $over_a };
397 like($@, $errpat, "Overload: array dereference");
398 is($warn, '', "no warning issued"); $warn = '';
400 eval { keys $over_h };
401 like($@, $errpat, "Overload: hash dereference");
402 is($warn, '', "no warning issued"); $warn = '';
404 eval { keys $over_b };
405 like($@, $errpat, "Overload: ambiguous dereference (both)");
406 is($warn, '', "no warning issued"); $warn = '';
408 eval { keys $over_h_a };
409 like($@, $errpat, "Overload: ambiguous dereference");
410 is($warn, '', "no warning issued"); $warn = '';
412 eval { keys $over_a_h };
413 like($@, $errpat, "Overload: ambiguous dereference");
414 is($warn, '', "no warning issued"); $warn = '';