Commit | Line | Data |
---|---|---|
cba5a3b0 DG |
1 | #!./perl |
2 | ||
3 | BEGIN { | |
4 | chdir 't' if -d 't'; | |
5 | @INC = '../lib'; | |
6 | require './test.pl'; | |
7 | } | |
8 | use strict; | |
9 | use warnings; | |
10 | no warnings 'deprecated'; | |
7ac5715b | 11 | use vars qw($data $array $values $hash $errpat); |
cba5a3b0 DG |
12 | |
13 | plan 'no_plan'; | |
14 | ||
15 | sub j { join(":",@_) } | |
16 | ||
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 } ; | |
21 | $data = { | |
22 | hash => { %$hash }, | |
23 | array => [ @$array ], | |
24 | }; | |
25 | } | |
26 | ||
27 | package Foo; | |
28 | sub new { | |
29 | my $self = { | |
30 | hash => {%{$main::hash} }, | |
31 | array => [@{$main::array}] | |
32 | }; | |
33 | bless $self, shift; | |
34 | } | |
35 | sub hash { no overloading; $_[0]->{hash} }; | |
36 | sub array { no overloading; $_[0]->{array} }; | |
37 | ||
38 | package Foo::Overload::Array; | |
39 | sub new { return bless [ qw/foo bar/ ], shift } | |
40 | use overload '@{}' => sub { $main::array }, fallback => 1; | |
41 | ||
42 | package Foo::Overload::Hash; | |
43 | sub new { return bless { qw/foo bar/ }, shift } | |
44 | use overload '%{}' => sub { $main::hash }, fallback => 1; | |
45 | ||
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; | |
50 | ||
51 | package Foo::Overload::HashOnArray; | |
52 | sub new { return bless [ qw/foo bar/ ], shift } | |
53 | use overload '%{}' => sub { $main::hash }, fallback => 1; | |
54 | ||
55 | package Foo::Overload::ArrayOnHash; | |
56 | sub new { return bless { qw/foo bar/ }, shift } | |
57 | use overload '@{}' => sub { $main::array }, fallback => 1; | |
58 | ||
59 | package main; | |
60 | ||
61 | use constant CONST_HASH => { %$hash }; | |
62 | use constant CONST_ARRAY => [ @$array ]; | |
63 | ||
64 | my %a_hash = %$hash; | |
65 | my @an_array = @$array; | |
66 | sub hash_sub { return \%a_hash; } | |
67 | sub array_sub { return \@an_array; } | |
68 | ||
69 | my $obj = Foo->new; | |
70 | ||
71 | my ($empty, $h_expect, $a_expect, @tmp, @tmp2, $k, $v); | |
72 | ||
73 | # Keys -- void | |
74 | ||
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;'); | |
89 | ||
90 | # Keys -- scalar | |
91 | ||
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'); | |
106 | ||
107 | # Keys -- list | |
108 | ||
109 | $h_expect = j(keys %$hash); | |
110 | $a_expect = j(keys @$array); | |
111 | ||
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'); | |
126 | ||
cba5a3b0 | 127 | # Keys -- vivification |
7ac5715b FC |
128 | undef $empty; |
129 | eval { keys $empty->{hash} }; | |
130 | ok(defined $empty, | |
131 | 'Vivify: $empty (after keys $empty->{hash}) is HASHREF'); | |
cba5a3b0 DG |
132 | ok(!defined $empty->{hash} , 'Vivify: $empty->{hash} is undef'); |
133 | ||
d8065907 FC |
134 | # Keys -- lvalue |
135 | $_{foo} = "bar"; | |
136 | keys \%_ = 65; | |
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'; | |
141 | ||
cba5a3b0 | 142 | # Keys -- errors |
7ac5715b FC |
143 | $errpat = qr/ |
144 | (?-x:Type of argument to keys on reference must be unblessed hashref or) | |
145 | (?-x: arrayref) | |
146 | /x; | |
147 | ||
148 | eval "keys undef"; | |
149 | ok($@ =~ $errpat, | |
150 | 'Errors: keys undef throws error' | |
151 | ); | |
152 | ||
153 | undef $empty; | |
154 | eval q"keys $empty"; | |
155 | ok($@ =~ $errpat, | |
156 | 'Errors: keys $undef throws error' | |
157 | ); | |
158 | ||
159 | is($empty, undef, 'keys $undef does not vivify $undef'); | |
160 | ||
cba5a3b0 | 161 | eval "keys 3"; |
7ac5715b | 162 | ok($@ =~ qr/Type of arg 1 to keys must be hash/, |
cba5a3b0 DG |
163 | 'Errors: keys CONSTANT throws error' |
164 | ); | |
165 | ||
166 | eval "keys qr/foo/"; | |
7ac5715b | 167 | ok($@ =~ $errpat, |
cba5a3b0 DG |
168 | 'Errors: keys qr/foo/ throws error' |
169 | ); | |
170 | ||
171 | eval "keys $hash qw/fo bar/"; | |
172 | ok($@ =~ qr/syntax error/, | |
173 | 'Errors: keys $hash, @stuff throws error' | |
174 | ) or print "# Got: $@"; | |
175 | ||
176 | # Values -- void | |
177 | ||
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;'); | |
192 | ||
193 | # Values -- scalar | |
194 | ||
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'); | |
209 | ||
210 | # Values -- list | |
211 | ||
212 | $h_expect = j(values %$hash); | |
213 | $a_expect = j(values @$array); | |
214 | ||
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'); | |
229 | ||
cba5a3b0 | 230 | # Values -- vivification |
7ac5715b FC |
231 | undef $empty; |
232 | eval { values $empty->{hash} }; | |
233 | ok(defined $empty, | |
234 | 'Vivify: $empty (after values $empty->{hash}) is HASHREF'); | |
cba5a3b0 DG |
235 | ok(!defined $empty->{hash} , 'Vivify: $empty->{hash} is undef'); |
236 | ||
237 | # Values -- errors | |
7ac5715b FC |
238 | $errpat = qr/ |
239 | (?-x:Type of argument to values on reference must be unblessed hashref or) | |
240 | (?-x: arrayref) | |
241 | /x; | |
242 | ||
243 | eval "values undef"; | |
244 | ok($@ =~ $errpat, | |
245 | 'Errors: values undef throws error' | |
246 | ); | |
247 | ||
248 | undef $empty; | |
249 | eval q"values $empty"; | |
250 | ok($@ =~ $errpat, | |
251 | 'Errors: values $undef throws error' | |
252 | ); | |
253 | ||
254 | is($empty, undef, 'values $undef does not vivify $undef'); | |
255 | ||
cba5a3b0 | 256 | eval "values 3"; |
7ac5715b | 257 | ok($@ =~ qr/Type of arg 1 to values must be hash/, |
cba5a3b0 DG |
258 | 'Errors: values CONSTANT throws error' |
259 | ); | |
260 | ||
261 | eval "values qr/foo/"; | |
7ac5715b | 262 | ok($@ =~ $errpat, |
cba5a3b0 DG |
263 | 'Errors: values qr/foo/ throws error' |
264 | ); | |
265 | ||
266 | eval "values $hash qw/fo bar/"; | |
267 | ok($@ =~ qr/syntax error/, | |
268 | 'Errors: values $hash, @stuff throws error' | |
269 | ) or print "# Got: $@"; | |
270 | ||
271 | # Each -- void | |
272 | ||
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'); | |
287 | ||
288 | # Reset iterators | |
289 | ||
290 | keys $hash; | |
291 | keys $data->{hash}; | |
292 | keys CONST_HASH; | |
293 | keys CONST_HASH(); | |
294 | keys hash_sub(); | |
295 | keys hash_sub; | |
296 | keys $obj->hash; | |
297 | keys $array; | |
298 | keys $data->{array}; | |
299 | keys CONST_ARRAY; | |
300 | keys CONST_ARRAY(); | |
301 | keys array_sub; | |
302 | keys array_sub(); | |
303 | keys $obj->array; | |
304 | ||
305 | # Each -- scalar | |
306 | ||
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'); | |
321 | ||
322 | # Each -- list | |
323 | ||
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'); | |
338 | ||
7ac5715b FC |
339 | # Each -- vivification |
340 | undef $empty; | |
341 | eval { each $empty->{hash} }; | |
342 | ok(defined $empty, | |
343 | 'Vivify: $empty (after each $empty->{hash}) is HASHREF'); | |
344 | ok(!defined $empty->{hash} , 'Vivify: $empty->{hash} is undef'); | |
345 | ||
346 | # Each -- errors | |
347 | $errpat = qr/ | |
348 | (?-x:Type of argument to each on reference must be unblessed hashref or) | |
349 | (?-x: arrayref) | |
350 | /x; | |
351 | ||
352 | eval "each undef"; | |
353 | ok($@ =~ $errpat, | |
354 | 'Errors: each undef throws error' | |
355 | ); | |
cba5a3b0 DG |
356 | |
357 | undef $empty; | |
7ac5715b FC |
358 | eval q"each $empty"; |
359 | ok($@ =~ $errpat, | |
360 | 'Errors: each $undef throws error' | |
361 | ); | |
cba5a3b0 | 362 | |
7ac5715b | 363 | is($empty, undef, 'each $undef does not vivify $undef'); |
cba5a3b0 | 364 | |
cba5a3b0 | 365 | eval "each 3"; |
7ac5715b | 366 | ok($@ =~ qr/Type of arg 1 to each must be hash/, |
cba5a3b0 DG |
367 | 'Errors: each CONSTANT throws error' |
368 | ); | |
369 | ||
370 | eval "each qr/foo/"; | |
7ac5715b | 371 | ok($@ =~ $errpat, |
cba5a3b0 DG |
372 | 'Errors: each qr/foo/ throws error' |
373 | ); | |
374 | ||
375 | eval "each $hash qw/foo bar/"; | |
376 | ok($@ =~ qr/syntax error/, | |
377 | 'Errors: each $hash, @stuff throws error' | |
378 | ) or print "# Got: $@"; | |
379 | ||
380 | # Overloaded objects | |
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; | |
386 | ||
cba5a3b0 DG |
387 | { |
388 | my $warn = ''; | |
389 | local $SIG{__WARN__} = sub { $warn = shift }; | |
390 | ||
7ac5715b FC |
391 | $errpat = qr/ |
392 | (?-x:Type of argument to keys on reference must be unblessed hashref or) | |
393 | (?-x: arrayref) | |
394 | /x; | |
395 | ||
396 | eval { keys $over_a }; | |
397 | like($@, $errpat, "Overload: array dereference"); | |
cba5a3b0 DG |
398 | is($warn, '', "no warning issued"); $warn = ''; |
399 | ||
7ac5715b FC |
400 | eval { keys $over_h }; |
401 | like($@, $errpat, "Overload: hash dereference"); | |
cba5a3b0 DG |
402 | is($warn, '', "no warning issued"); $warn = ''; |
403 | ||
7ac5715b FC |
404 | eval { keys $over_b }; |
405 | like($@, $errpat, "Overload: ambiguous dereference (both)"); | |
406 | is($warn, '', "no warning issued"); $warn = ''; | |
cba5a3b0 | 407 | |
7ac5715b FC |
408 | eval { keys $over_h_a }; |
409 | like($@, $errpat, "Overload: ambiguous dereference"); | |
410 | is($warn, '', "no warning issued"); $warn = ''; | |
cba5a3b0 | 411 | |
7ac5715b FC |
412 | eval { keys $over_a_h }; |
413 | like($@, $errpat, "Overload: ambiguous dereference"); | |
414 | is($warn, '', "no warning issued"); $warn = ''; | |
cba5a3b0 | 415 | } |