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
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
|
my %global_hash;
my @global_array;
my $global_scalar;
sub global_sub {}
my %global_hash2;
my @global_array2;
my $global_scalar2;
sub global_sub2 {}
# Test basic coercions...
package BaseClass;
use Class::Std;
{
sub as_str : STRINGIFY { return 'hello world' }
sub as_num : NUMERIFY { return 42 }
sub as_bool : BOOLIFY { return }
sub as_code : CODIFY { return \&::global_sub }
sub as_glob : GLOBIFY { return \*::global_glob }
sub as_hash : HASHIFY { return \%global_hash }
sub as_array : ARRAYIFY { return \@global_array }
sub as_scalar : SCALARIFY { return \$global_scalar }
}
# Test inheritance without change...
package DerClass;
use base qw( BaseClass );
# Test inheritance with change...
package DerClass2;
use Class::Std;
use base qw( BaseClass );
{
sub as_str : STRINGIFY { return 'goodbye world' }
sub as_num : NUMERIFY { return 86 }
sub as_bool : BOOLIFY { return 1 }
sub as_code : CODIFY { return \&::global_sub2 }
sub as_glob : GLOBIFY { return \*::global_glob2 }
sub as_hash : HASHIFY { return \%global_hash2 }
sub as_array : ARRAYIFY { return \@global_array2 }
sub as_scalar : SCALARIFY { return \$global_scalar2 }
}
# Test inheritance with change and they didn't "use Class::Std"
package DerClass3;
use base qw( BaseClass );
{
sub as_str : STRINGIFY { return 'goodbye world' }
sub as_num : NUMERIFY { return 86 }
sub as_bool : BOOLIFY { return 1 }
sub as_code : CODIFY { return \&::global_sub2 }
sub as_glob : GLOBIFY { return \*::global_glob2 }
sub as_hash : HASHIFY { return \%global_hash2 }
sub as_array : ARRAYIFY { return \@global_array2 }
sub as_scalar : SCALARIFY { return \$global_scalar2 }
}
# Test inheritance with change and they don't re-specify the coercions
package DerClass4;
use base qw( BaseClass );
{
sub as_str { return 'goodbye world' }
sub as_num { return 86 }
sub as_bool { return 1 }
sub as_code { return \&::global_sub2 }
sub as_glob { return \*::global_glob2 }
sub as_hash { return \%global_hash2 }
sub as_array { return \@global_array2 }
sub as_scalar { return \$global_scalar2 }
}
# Test inheritance with changing the subs used for the coercions
package DerClass5;
use base qw( BaseClass );
{
sub as_str_changed : STRINGIFY { return 'goodbye world' }
sub as_num_changed : NUMERIFY { return 86 }
sub as_bool_changed : BOOLIFY { return 1 }
sub as_code_changed : CODIFY { return \&::global_sub2 }
sub as_glob_changed : GLOBIFY { return \*::global_glob2 }
sub as_hash_changed : HASHIFY { return \%global_hash2 }
sub as_array_changed : ARRAYIFY { return \@global_array2 }
sub as_scalar_changed : SCALARIFY { return \$global_scalar2 }
}
package main;
use Test::More 'no_plan';
my $obj;
# Basic coercions...
$obj = BaseClass->new();
ok !$obj => 'Base Boolean coercion';
is 0+$obj, 42 => 'Base Numeric coercion';
is "$obj", 'hello world' => 'Base String coercion';
is \&{$obj}, \&global_sub => 'Base Code coercion';
is \*{$obj}, \*global_glob => 'Base Glob coercion';
is \%{$obj}, \%global_hash => 'Base Hash coercion';
is \@{$obj}, \@global_array => 'Base Array coercion';
is \${$obj}, \$global_scalar => 'Base Scalar coercion';
# Inheriting coercions...
$obj = DerClass->new();
ok !$obj => 'Der Boolean coercion';
is 0+$obj, 42 => 'Der Numeric coercion';
is "$obj", 'hello world' => 'Der String coercion';
is \&{$obj}, \&global_sub => 'Der Code coercion';
is \*{$obj}, \*global_glob => 'Der Glob coercion';
is \%{$obj}, \%global_hash => 'Der Hash coercion';
is \@{$obj}, \@global_array => 'Der Array coercion';
is \${$obj}, \$global_scalar => 'Der Scalar coercion';
# Redefining coercions on inheritance...
$obj = DerClass2->new();
ok $obj => 'Der2 Boolean coercion';
is 0+$obj, 86 => 'Der2 Numeric coercion';
is "$obj", 'goodbye world' => 'Der2 String coercion';
is \&{$obj}, \&global_sub2 => 'Der2 Code coercion';
is \*{$obj}, \*global_glob2 => 'Der2 Glob coercion';
is \%{$obj}, \%global_hash2 => 'Der2 Hash coercion';
is \@{$obj}, \@global_array2 => 'Der2 Array coercion';
is \${$obj}, \$global_scalar2 => 'Der2 Scalar coercion';
# Redefining coercions on inheritance and there is no "use Class::Std"
# in the subclass
$obj = DerClass3->new();
ok $obj => 'Der3 Boolean coercion';
is 0+$obj, 86 => 'Der3 Numeric coercion';
is "$obj", 'goodbye world' => 'Der3 String coercion';
is \&{$obj}, \&global_sub2 => 'Der3 Code coercion';
is \*{$obj}, \*global_glob2 => 'Der3 Glob coercion';
is \%{$obj}, \%global_hash2 => 'Der3 Hash coercion';
is \@{$obj}, \@global_array2 => 'Der3 Array coercion';
is \${$obj}, \$global_scalar2 => 'Der3 Scalar coercion';
# The subclass doesn't need to specify the coercions again
$obj = DerClass4->new();
ok $obj => 'Der4 Boolean coercion';
is 0+$obj, 86 => 'Der4 Numeric coercion';
is "$obj", 'goodbye world' => 'Der4 String coercion';
is \&{$obj}, \&global_sub2 => 'Der4 Code coercion';
is \*{$obj}, \*global_glob2 => 'Der4 Glob coercion';
is \%{$obj}, \%global_hash2 => 'Der4 Hash coercion';
is \@{$obj}, \@global_array2 => 'Der4 Array coercion';
is \${$obj}, \$global_scalar2 => 'Der4 Scalar coercion';
# The subclass doesn't need to specify the coercions again
$obj = DerClass5->new();
ok $obj => 'Der5 Boolean coercion';
is 0+$obj, 86 => 'Der5 Numeric coercion';
is "$obj", 'goodbye world' => 'Der5 String coercion';
is \&{$obj}, \&global_sub2 => 'Der5 Code coercion';
is \*{$obj}, \*global_glob2 => 'Der5 Glob coercion';
is \%{$obj}, \%global_hash2 => 'Der5 Hash coercion';
is \@{$obj}, \@global_array2 => 'Der5 Array coercion';
is \${$obj}, \$global_scalar2 => 'Der5 Scalar coercion';
|
