1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
|
#!perl-w
use strict;
use Test::More tests => 36;
use Test::Exception;
use Data::Util qw(:all);
BEGIN{
package Foo;
use overload fallback => 1;
sub new{
bless {} => shift;
}
package MyArray;
use overload
'@{}' => 'as_array',
fallback => 1;
sub new{
bless {array => []} => shift;
}
sub as_array{
shift()->{array};
}
package AnyRef;
use overload
'@{}' => 'as_array',
'%{}' => 'as_hash',
'${}' => 'as_scalar',
'*{}' => 'as_glob',
'&{}' => 'as_code',
fallback => 1;
my $s;
my @a;
my %h;
my $gref; select select $gref;
sub c{1}
sub new{
bless {} => shift;
}
sub as_scalar{
\$s;
}
sub as_array{
\@a;
}
sub as_hash{
\%h;
}
sub as_glob{
$gref;
}
sub as_code{
\&c;
}
package DerivedAnyRef;
our @ISA = qw(AnyRef);
}
# :check
my $foo = Foo->new();
ok !is_array_ref($foo), 'check with overloaded';
ok !is_hash_ref($foo);
my $ma = MyArray->new();
ok is_array_ref($ma);
ok !is_hash_ref($ma);
ok !is_scalar_ref($ma);
ok !is_code_ref($ma);
ok !is_glob_ref($ma);
ok !is_regex_ref($ma);
for my $ref(AnyRef->new(), DerivedAnyRef->new()){
ok is_array_ref($ref);
ok is_hash_ref($ref);
ok is_scalar_ref($ref);
ok is_code_ref($ref);
ok is_glob_ref($ref);
}
# :validate
$foo = Foo->new();
dies_ok{
array_ref($foo);
} 'validate with overloaded';
dies_ok{
hash_ref($foo);
};
$ma = MyArray->new();
lives_and{
ok array_ref($ma);
};
dies_ok{ hash_ref($ma) };
dies_ok{ scalar_ref($ma) };
dies_ok{ code_ref($ma) };
dies_ok{ glob_ref($ma) };
dies_ok{ regex_ref($ma) };
for my $ref(AnyRef->new(), DerivedAnyRef->new()){
lives_and{
ok array_ref($ref);
ok hash_ref($ref);
ok scalar_ref($ref);
ok code_ref($ref);
ok glob_ref($ref);
};
}
|
