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 | ||
0b3fe645 YO |
17 | # NOTE |
18 | # | |
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. | |
26 | our %base_hash; | |
27 | ||
cba5a3b0 | 28 | BEGIN { # in BEGIN for "use constant ..." later |
0b3fe645 | 29 | %base_hash= ( pi => 3.14, e => 2.72, i => -1 ); |
cba5a3b0 DG |
30 | $array = [ qw(pi e i) ]; |
31 | $values = [ 3.14, 2.72, -1 ]; | |
0b3fe645 | 32 | $hash = { %base_hash } ; |
cba5a3b0 | 33 | $data = { |
0b3fe645 | 34 | hash => { %base_hash }, |
cba5a3b0 DG |
35 | array => [ @$array ], |
36 | }; | |
37 | } | |
38 | ||
39 | package Foo; | |
40 | sub new { | |
41 | my $self = { | |
0b3fe645 | 42 | hash => { %base_hash }, |
cba5a3b0 DG |
43 | array => [@{$main::array}] |
44 | }; | |
45 | bless $self, shift; | |
46 | } | |
47 | sub hash { no overloading; $_[0]->{hash} }; | |
48 | sub array { no overloading; $_[0]->{array} }; | |
49 | ||
50 | package Foo::Overload::Array; | |
51 | sub new { return bless [ qw/foo bar/ ], shift } | |
52 | use overload '@{}' => sub { $main::array }, fallback => 1; | |
53 | ||
54 | package Foo::Overload::Hash; | |
55 | sub new { return bless { qw/foo bar/ }, shift } | |
56 | use overload '%{}' => sub { $main::hash }, fallback => 1; | |
57 | ||
58 | package Foo::Overload::Both; | |
59 | sub new { return bless { qw/foo bar/ }, shift } | |
60 | use overload '%{}' => sub { $main::hash }, | |
61 | '@{}' => sub { $main::array }, fallback => 1; | |
62 | ||
63 | package Foo::Overload::HashOnArray; | |
64 | sub new { return bless [ qw/foo bar/ ], shift } | |
65 | use overload '%{}' => sub { $main::hash }, fallback => 1; | |
66 | ||
67 | package Foo::Overload::ArrayOnHash; | |
68 | sub new { return bless { qw/foo bar/ }, shift } | |
69 | use overload '@{}' => sub { $main::array }, fallback => 1; | |
70 | ||
71 | package main; | |
72 | ||
0b3fe645 | 73 | use constant CONST_HASH => { %base_hash }; |
cba5a3b0 DG |
74 | use constant CONST_ARRAY => [ @$array ]; |
75 | ||
0b3fe645 | 76 | my %a_hash = %base_hash; |
cba5a3b0 DG |
77 | my @an_array = @$array; |
78 | sub hash_sub { return \%a_hash; } | |
79 | sub array_sub { return \@an_array; } | |
80 | ||
81 | my $obj = Foo->new; | |
82 | ||
83 | my ($empty, $h_expect, $a_expect, @tmp, @tmp2, $k, $v); | |
84 | ||
85 | # Keys -- void | |
86 | ||
87 | keys $hash; pass('Void: keys $hash;'); | |
88 | keys $data->{hash}; pass('Void: keys $data->{hash};'); | |
89 | keys CONST_HASH; pass('Void: keys CONST_HASH;'); | |
90 | keys CONST_HASH(); pass('Void: keys CONST_HASH();'); | |
91 | keys hash_sub(); pass('Void: keys hash_sub();'); | |
92 | keys hash_sub; pass('Void: keys hash_sub;'); | |
93 | keys $obj->hash; pass('Void: keys $obj->hash;'); | |
94 | keys $array; pass('Void: keys $array;'); | |
95 | keys $data->{array}; pass('Void: keys $data->{array};'); | |
96 | keys CONST_ARRAY; pass('Void: keys CONST_ARRAY;'); | |
97 | keys CONST_ARRAY(); pass('Void: keys CONST_ARRAY();'); | |
98 | keys array_sub; pass('Void: keys array_sub;'); | |
99 | keys array_sub(); pass('Void: keys array_sub();'); | |
100 | keys $obj->array; pass('Void: keys $obj->array;'); | |
101 | ||
102 | # Keys -- scalar | |
103 | ||
104 | is(keys $hash ,3, 'Scalar: keys $hash'); | |
105 | is(keys $data->{hash} ,3, 'Scalar: keys $data->{hash}'); | |
106 | is(keys CONST_HASH ,3, 'Scalar: keys CONST_HASH'); | |
107 | is(keys CONST_HASH() ,3, 'Scalar: keys CONST_HASH()'); | |
108 | is(keys hash_sub ,3, 'Scalar: keys hash_sub'); | |
109 | is(keys hash_sub() ,3, 'Scalar: keys hash_sub()'); | |
110 | is(keys $obj->hash ,3, 'Scalar: keys $obj->hash'); | |
111 | is(keys $array ,3, 'Scalar: keys $array'); | |
112 | is(keys $data->{array} ,3, 'Scalar: keys $data->{array}'); | |
113 | is(keys CONST_ARRAY ,3, 'Scalar: keys CONST_ARRAY'); | |
114 | is(keys CONST_ARRAY() ,3, 'Scalar: keys CONST_ARRAY()'); | |
115 | is(keys array_sub ,3, 'Scalar: keys array_sub'); | |
116 | is(keys array_sub() ,3, 'Scalar: keys array_sub()'); | |
117 | is(keys $obj->array ,3, 'Scalar: keys $obj->array'); | |
118 | ||
119 | # Keys -- list | |
120 | ||
121 | $h_expect = j(keys %$hash); | |
122 | $a_expect = j(keys @$array); | |
123 | ||
124 | is(j(keys $hash) ,$h_expect, 'List: keys $hash'); | |
125 | is(j(keys $data->{hash}) ,$h_expect, 'List: keys $data->{hash}'); | |
126 | is(j(keys CONST_HASH) ,$h_expect, 'List: keys CONST_HASH'); | |
127 | is(j(keys CONST_HASH()) ,$h_expect, 'List: keys CONST_HASH()'); | |
128 | is(j(keys hash_sub) ,$h_expect, 'List: keys hash_sub'); | |
129 | is(j(keys hash_sub()) ,$h_expect, 'List: keys hash_sub()'); | |
130 | is(j(keys $obj->hash) ,$h_expect, 'List: keys $obj->hash'); | |
131 | is(j(keys $array) ,$a_expect, 'List: keys $array'); | |
132 | is(j(keys $data->{array}) ,$a_expect, 'List: keys $data->{array}'); | |
133 | is(j(keys CONST_ARRAY) ,$a_expect, 'List: keys CONST_ARRAY'); | |
134 | is(j(keys CONST_ARRAY()) ,$a_expect, 'List: keys CONST_ARRAY()'); | |
135 | is(j(keys array_sub) ,$a_expect, 'List: keys array_sub'); | |
136 | is(j(keys array_sub()) ,$a_expect, 'List: keys array_sub()'); | |
137 | is(j(keys $obj->array) ,$a_expect, 'List: keys $obj->array'); | |
138 | ||
cba5a3b0 | 139 | # Keys -- vivification |
7ac5715b FC |
140 | undef $empty; |
141 | eval { keys $empty->{hash} }; | |
142 | ok(defined $empty, | |
143 | 'Vivify: $empty (after keys $empty->{hash}) is HASHREF'); | |
cba5a3b0 DG |
144 | ok(!defined $empty->{hash} , 'Vivify: $empty->{hash} is undef'); |
145 | ||
d8065907 FC |
146 | # Keys -- lvalue |
147 | $_{foo} = "bar"; | |
148 | keys \%_ = 65; | |
149 | is scalar %_, '1/128', 'keys $hashref as lvalue'; | |
150 | eval 'keys \@_ = 65'; | |
151 | like $@, qr/Can't modify keys on reference in scalar assignment/, | |
152 | 'keys $arrayref as lvalue dies'; | |
153 | ||
cba5a3b0 | 154 | # Keys -- errors |
7ac5715b FC |
155 | $errpat = qr/ |
156 | (?-x:Type of argument to keys on reference must be unblessed hashref or) | |
157 | (?-x: arrayref) | |
158 | /x; | |
159 | ||
160 | eval "keys undef"; | |
161 | ok($@ =~ $errpat, | |
162 | 'Errors: keys undef throws error' | |
163 | ); | |
164 | ||
165 | undef $empty; | |
166 | eval q"keys $empty"; | |
167 | ok($@ =~ $errpat, | |
168 | 'Errors: keys $undef throws error' | |
169 | ); | |
170 | ||
171 | is($empty, undef, 'keys $undef does not vivify $undef'); | |
172 | ||
cba5a3b0 | 173 | eval "keys 3"; |
7ac5715b | 174 | ok($@ =~ qr/Type of arg 1 to keys must be hash/, |
cba5a3b0 DG |
175 | 'Errors: keys CONSTANT throws error' |
176 | ); | |
177 | ||
178 | eval "keys qr/foo/"; | |
7ac5715b | 179 | ok($@ =~ $errpat, |
cba5a3b0 DG |
180 | 'Errors: keys qr/foo/ throws error' |
181 | ); | |
182 | ||
183 | eval "keys $hash qw/fo bar/"; | |
184 | ok($@ =~ qr/syntax error/, | |
185 | 'Errors: keys $hash, @stuff throws error' | |
186 | ) or print "# Got: $@"; | |
187 | ||
188 | # Values -- void | |
189 | ||
190 | values $hash; pass('Void: values $hash;'); | |
191 | values $data->{hash}; pass('Void: values $data->{hash};'); | |
192 | values CONST_HASH; pass('Void: values CONST_HASH;'); | |
193 | values CONST_HASH(); pass('Void: values CONST_HASH();'); | |
194 | values hash_sub(); pass('Void: values hash_sub();'); | |
195 | values hash_sub; pass('Void: values hash_sub;'); | |
196 | values $obj->hash; pass('Void: values $obj->hash;'); | |
197 | values $array; pass('Void: values $array;'); | |
198 | values $data->{array}; pass('Void: values $data->{array};'); | |
199 | values CONST_ARRAY; pass('Void: values CONST_ARRAY;'); | |
200 | values CONST_ARRAY(); pass('Void: values CONST_ARRAY();'); | |
201 | values array_sub; pass('Void: values array_sub;'); | |
202 | values array_sub(); pass('Void: values array_sub();'); | |
203 | values $obj->array; pass('Void: values $obj->array;'); | |
204 | ||
205 | # Values -- scalar | |
206 | ||
207 | is(values $hash ,3, 'Scalar: values $hash'); | |
208 | is(values $data->{hash} ,3, 'Scalar: values $data->{hash}'); | |
209 | is(values CONST_HASH ,3, 'Scalar: values CONST_HASH'); | |
210 | is(values CONST_HASH() ,3, 'Scalar: values CONST_HASH()'); | |
211 | is(values hash_sub ,3, 'Scalar: values hash_sub'); | |
212 | is(values hash_sub() ,3, 'Scalar: values hash_sub()'); | |
213 | is(values $obj->hash ,3, 'Scalar: values $obj->hash'); | |
214 | is(values $array ,3, 'Scalar: values $array'); | |
215 | is(values $data->{array} ,3, 'Scalar: values $data->{array}'); | |
216 | is(values CONST_ARRAY ,3, 'Scalar: values CONST_ARRAY'); | |
217 | is(values CONST_ARRAY() ,3, 'Scalar: values CONST_ARRAY()'); | |
218 | is(values array_sub ,3, 'Scalar: values array_sub'); | |
219 | is(values array_sub() ,3, 'Scalar: values array_sub()'); | |
220 | is(values $obj->array ,3, 'Scalar: values $obj->array'); | |
221 | ||
222 | # Values -- list | |
223 | ||
224 | $h_expect = j(values %$hash); | |
225 | $a_expect = j(values @$array); | |
226 | ||
227 | is(j(values $hash) ,$h_expect, 'List: values $hash'); | |
228 | is(j(values $data->{hash}) ,$h_expect, 'List: values $data->{hash}'); | |
229 | is(j(values CONST_HASH) ,$h_expect, 'List: values CONST_HASH'); | |
230 | is(j(values CONST_HASH()) ,$h_expect, 'List: values CONST_HASH()'); | |
231 | is(j(values hash_sub) ,$h_expect, 'List: values hash_sub'); | |
232 | is(j(values hash_sub()) ,$h_expect, 'List: values hash_sub()'); | |
233 | is(j(values $obj->hash) ,$h_expect, 'List: values $obj->hash'); | |
234 | is(j(values $array) ,$a_expect, 'List: values $array'); | |
235 | is(j(values $data->{array}) ,$a_expect, 'List: values $data->{array}'); | |
236 | is(j(values CONST_ARRAY) ,$a_expect, 'List: values CONST_ARRAY'); | |
237 | is(j(values CONST_ARRAY()) ,$a_expect, 'List: values CONST_ARRAY()'); | |
238 | is(j(values array_sub) ,$a_expect, 'List: values array_sub'); | |
239 | is(j(values array_sub()) ,$a_expect, 'List: values array_sub()'); | |
240 | is(j(values $obj->array) ,$a_expect, 'List: values $obj->array'); | |
241 | ||
cba5a3b0 | 242 | # Values -- vivification |
7ac5715b FC |
243 | undef $empty; |
244 | eval { values $empty->{hash} }; | |
245 | ok(defined $empty, | |
246 | 'Vivify: $empty (after values $empty->{hash}) is HASHREF'); | |
cba5a3b0 DG |
247 | ok(!defined $empty->{hash} , 'Vivify: $empty->{hash} is undef'); |
248 | ||
249 | # Values -- errors | |
7ac5715b FC |
250 | $errpat = qr/ |
251 | (?-x:Type of argument to values on reference must be unblessed hashref or) | |
252 | (?-x: arrayref) | |
253 | /x; | |
254 | ||
255 | eval "values undef"; | |
256 | ok($@ =~ $errpat, | |
257 | 'Errors: values undef throws error' | |
258 | ); | |
259 | ||
260 | undef $empty; | |
261 | eval q"values $empty"; | |
262 | ok($@ =~ $errpat, | |
263 | 'Errors: values $undef throws error' | |
264 | ); | |
265 | ||
266 | is($empty, undef, 'values $undef does not vivify $undef'); | |
267 | ||
cba5a3b0 | 268 | eval "values 3"; |
7ac5715b | 269 | ok($@ =~ qr/Type of arg 1 to values must be hash/, |
cba5a3b0 DG |
270 | 'Errors: values CONSTANT throws error' |
271 | ); | |
272 | ||
273 | eval "values qr/foo/"; | |
7ac5715b | 274 | ok($@ =~ $errpat, |
cba5a3b0 DG |
275 | 'Errors: values qr/foo/ throws error' |
276 | ); | |
277 | ||
278 | eval "values $hash qw/fo bar/"; | |
279 | ok($@ =~ qr/syntax error/, | |
280 | 'Errors: values $hash, @stuff throws error' | |
281 | ) or print "# Got: $@"; | |
282 | ||
283 | # Each -- void | |
284 | ||
285 | each $hash; pass('Void: each $hash'); | |
286 | each $data->{hash}; pass('Void: each $data->{hash}'); | |
287 | each CONST_HASH; pass('Void: each CONST_HASH'); | |
288 | each CONST_HASH(); pass('Void: each CONST_HASH()'); | |
289 | each hash_sub(); pass('Void: each hash_sub()'); | |
290 | each hash_sub; pass('Void: each hash_sub'); | |
291 | each $obj->hash; pass('Void: each $obj->hash'); | |
292 | each $array; pass('Void: each $array'); | |
293 | each $data->{array}; pass('Void: each $data->{array}'); | |
294 | each CONST_ARRAY; pass('Void: each CONST_ARRAY'); | |
295 | each CONST_ARRAY(); pass('Void: each CONST_ARRAY()'); | |
296 | each array_sub; pass('Void: each array_sub'); | |
297 | each array_sub(); pass('Void: each array_sub()'); | |
298 | each $obj->array; pass('Void: each $obj->array'); | |
299 | ||
300 | # Reset iterators | |
301 | ||
302 | keys $hash; | |
303 | keys $data->{hash}; | |
304 | keys CONST_HASH; | |
305 | keys CONST_HASH(); | |
306 | keys hash_sub(); | |
307 | keys hash_sub; | |
308 | keys $obj->hash; | |
309 | keys $array; | |
310 | keys $data->{array}; | |
311 | keys CONST_ARRAY; | |
312 | keys CONST_ARRAY(); | |
313 | keys array_sub; | |
314 | keys array_sub(); | |
315 | keys $obj->array; | |
316 | ||
317 | # Each -- scalar | |
318 | ||
319 | @tmp=(); while(defined( $k = each $hash)) {push @tmp,$k}; is(j(@tmp),j(keys $hash), 'Scalar: each $hash'); | |
320 | @tmp=(); while(defined( $k = each $data->{hash})){push @tmp,$k}; is(j(@tmp),j(keys $data->{hash}), 'Scalar: each $data->{hash}'); | |
321 | @tmp=(); while(defined( $k = each CONST_HASH)){push @tmp,$k}; is(j(@tmp),j(keys CONST_HASH), 'Scalar: each CONST_HASH'); | |
322 | @tmp=(); while(defined( $k = each CONST_HASH())){push @tmp,$k}; is(j(@tmp),j(keys CONST_HASH()), 'Scalar: each CONST_HASH()'); | |
323 | @tmp=(); while(defined( $k = each hash_sub())){push @tmp,$k}; is(j(@tmp),j(keys hash_sub()), 'Scalar: each hash_sub()'); | |
324 | @tmp=(); while(defined( $k = each hash_sub)){push @tmp,$k}; is(j(@tmp),j(keys hash_sub), 'Scalar: each hash_sub'); | |
325 | @tmp=(); while(defined( $k = each $obj->hash)){push @tmp,$k}; is(j(@tmp),j(keys $obj->hash), 'Scalar: each $obj->hash'); | |
326 | @tmp=(); while(defined( $k = each $array)){push @tmp,$k}; is(j(@tmp),j(keys $array), 'Scalar: each $array'); | |
327 | @tmp=(); while(defined( $k = each $data->{array})){push @tmp,$k}; is(j(@tmp),j(keys $data->{array}), 'Scalar: each $data->{array}'); | |
328 | @tmp=(); while(defined( $k = each CONST_ARRAY)){push @tmp,$k}; is(j(@tmp),j(keys CONST_ARRAY), 'Scalar: each CONST_ARRAY'); | |
329 | @tmp=(); while(defined( $k = each CONST_ARRAY())){push @tmp,$k}; is(j(@tmp),j(keys CONST_ARRAY()), 'Scalar: each CONST_ARRAY()'); | |
330 | @tmp=(); while(defined( $k = each array_sub)){push @tmp,$k}; is(j(@tmp),j(keys array_sub), 'Scalar: each array_sub'); | |
331 | @tmp=(); while(defined( $k = each array_sub())){push @tmp,$k}; is(j(@tmp),j(keys array_sub()), 'Scalar: each array_sub()'); | |
332 | @tmp=(); while(defined( $k = each $obj->array)){push @tmp,$k}; is(j(@tmp),j(keys $obj->array), 'Scalar: each $obj->array'); | |
333 | ||
334 | # Each -- list | |
335 | ||
336 | @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'); | |
337 | @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}'); | |
338 | @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'); | |
339 | @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()'); | |
340 | @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()'); | |
341 | @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'); | |
342 | @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'); | |
343 | @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'); | |
344 | @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}'); | |
345 | @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'); | |
346 | @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()'); | |
347 | @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'); | |
348 | @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()'); | |
349 | @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'); | |
350 | ||
7ac5715b FC |
351 | # Each -- vivification |
352 | undef $empty; | |
353 | eval { each $empty->{hash} }; | |
354 | ok(defined $empty, | |
355 | 'Vivify: $empty (after each $empty->{hash}) is HASHREF'); | |
356 | ok(!defined $empty->{hash} , 'Vivify: $empty->{hash} is undef'); | |
357 | ||
358 | # Each -- errors | |
359 | $errpat = qr/ | |
360 | (?-x:Type of argument to each on reference must be unblessed hashref or) | |
361 | (?-x: arrayref) | |
362 | /x; | |
363 | ||
364 | eval "each undef"; | |
365 | ok($@ =~ $errpat, | |
366 | 'Errors: each undef throws error' | |
367 | ); | |
cba5a3b0 DG |
368 | |
369 | undef $empty; | |
7ac5715b FC |
370 | eval q"each $empty"; |
371 | ok($@ =~ $errpat, | |
372 | 'Errors: each $undef throws error' | |
373 | ); | |
cba5a3b0 | 374 | |
7ac5715b | 375 | is($empty, undef, 'each $undef does not vivify $undef'); |
cba5a3b0 | 376 | |
cba5a3b0 | 377 | eval "each 3"; |
7ac5715b | 378 | ok($@ =~ qr/Type of arg 1 to each must be hash/, |
cba5a3b0 DG |
379 | 'Errors: each CONSTANT throws error' |
380 | ); | |
381 | ||
382 | eval "each qr/foo/"; | |
7ac5715b | 383 | ok($@ =~ $errpat, |
cba5a3b0 DG |
384 | 'Errors: each qr/foo/ throws error' |
385 | ); | |
386 | ||
387 | eval "each $hash qw/foo bar/"; | |
388 | ok($@ =~ qr/syntax error/, | |
389 | 'Errors: each $hash, @stuff throws error' | |
390 | ) or print "# Got: $@"; | |
391 | ||
392 | # Overloaded objects | |
393 | my $over_a = Foo::Overload::Array->new; | |
394 | my $over_h = Foo::Overload::Hash->new; | |
395 | my $over_b = Foo::Overload::Both->new; | |
396 | my $over_h_a = Foo::Overload::HashOnArray->new; | |
397 | my $over_a_h = Foo::Overload::ArrayOnHash->new; | |
398 | ||
cba5a3b0 DG |
399 | { |
400 | my $warn = ''; | |
401 | local $SIG{__WARN__} = sub { $warn = shift }; | |
402 | ||
7ac5715b FC |
403 | $errpat = qr/ |
404 | (?-x:Type of argument to keys on reference must be unblessed hashref or) | |
405 | (?-x: arrayref) | |
406 | /x; | |
407 | ||
408 | eval { keys $over_a }; | |
409 | like($@, $errpat, "Overload: array dereference"); | |
cba5a3b0 DG |
410 | is($warn, '', "no warning issued"); $warn = ''; |
411 | ||
7ac5715b FC |
412 | eval { keys $over_h }; |
413 | like($@, $errpat, "Overload: hash dereference"); | |
cba5a3b0 DG |
414 | is($warn, '', "no warning issued"); $warn = ''; |
415 | ||
7ac5715b FC |
416 | eval { keys $over_b }; |
417 | like($@, $errpat, "Overload: ambiguous dereference (both)"); | |
418 | is($warn, '', "no warning issued"); $warn = ''; | |
cba5a3b0 | 419 | |
7ac5715b FC |
420 | eval { keys $over_h_a }; |
421 | like($@, $errpat, "Overload: ambiguous dereference"); | |
422 | is($warn, '', "no warning issued"); $warn = ''; | |
cba5a3b0 | 423 | |
7ac5715b FC |
424 | eval { keys $over_a_h }; |
425 | like($@, $errpat, "Overload: ambiguous dereference"); | |
426 | is($warn, '', "no warning issued"); $warn = ''; | |
cba5a3b0 | 427 | } |