1my  %global_hash;
2my  @global_array;
3my  $global_scalar;
4sub  global_sub {}
5
6my  %global_hash2;
7my  @global_array2;
8my  $global_scalar2;
9sub  global_sub2 {}
10
11# Test basic coercions...
12package BaseClass;
13use Class::Std;
14{
15    sub as_str    : STRINGIFY  { return 'hello world' }
16    sub as_num    : NUMERIFY   { return 42 }
17    sub as_bool   : BOOLIFY    { return }
18
19    sub as_code   : CODIFY     { return \&::global_sub    }
20    sub as_glob   : GLOBIFY    { return \*::global_glob   }
21    sub as_hash   : HASHIFY    { return \%global_hash   }
22    sub as_array  : ARRAYIFY   { return \@global_array  }
23    sub as_scalar : SCALARIFY  { return \$global_scalar }
24}
25
26# Test inheritance without change...
27package DerClass;
28use base qw( BaseClass );
29
30# Test inheritance with change...
31package DerClass2;
32use Class::Std;
33use base qw( BaseClass );
34{
35    sub as_str    : STRINGIFY  { return 'goodbye world' }
36    sub as_num    : NUMERIFY   { return 86 }
37    sub as_bool   : BOOLIFY    { return 1 }
38
39    sub as_code   : CODIFY     { return \&::global_sub2    }
40    sub as_glob   : GLOBIFY    { return \*::global_glob2   }
41    sub as_hash   : HASHIFY    { return \%global_hash2     }
42    sub as_array  : ARRAYIFY   { return \@global_array2    }
43    sub as_scalar : SCALARIFY  { return \$global_scalar2   }
44}
45
46# Test inheritance with change and they didn't "use Class::Std"
47package DerClass3;
48use base qw( BaseClass );
49{
50    sub as_str    : STRINGIFY  { return 'goodbye world' }
51    sub as_num    : NUMERIFY   { return 86 }
52    sub as_bool   : BOOLIFY    { return 1 }
53
54    sub as_code   : CODIFY     { return \&::global_sub2    }
55    sub as_glob   : GLOBIFY    { return \*::global_glob2   }
56    sub as_hash   : HASHIFY    { return \%global_hash2     }
57    sub as_array  : ARRAYIFY   { return \@global_array2    }
58    sub as_scalar : SCALARIFY  { return \$global_scalar2   }
59}
60
61# Test inheritance with change and they don't re-specify the coercions
62package DerClass4;
63use base qw( BaseClass );
64{
65    sub as_str     { return 'goodbye world' }
66    sub as_num     { return 86 }
67    sub as_bool    { return 1 }
68
69    sub as_code    { return \&::global_sub2    }
70    sub as_glob    { return \*::global_glob2   }
71    sub as_hash    { return \%global_hash2     }
72    sub as_array   { return \@global_array2    }
73    sub as_scalar  { return \$global_scalar2   }
74}
75
76# Test inheritance with changing the subs used for the coercions
77package DerClass5;
78use base qw( BaseClass );
79{
80    sub as_str_changed    : STRINGIFY { return 'goodbye world' }
81    sub as_num_changed    : NUMERIFY  { return 86 }
82    sub as_bool_changed   : BOOLIFY   { return 1 }
83
84    sub as_code_changed   : CODIFY    { return \&::global_sub2    }
85    sub as_glob_changed   : GLOBIFY   { return \*::global_glob2   }
86    sub as_hash_changed   : HASHIFY   { return \%global_hash2     }
87    sub as_array_changed  : ARRAYIFY  { return \@global_array2    }
88    sub as_scalar_changed : SCALARIFY { return \$global_scalar2   }
89}
90
91
92package main;
93
94use Test::More 'no_plan';
95
96my $obj;
97
98# Basic coercions...
99
100$obj = BaseClass->new();
101
102ok !$obj                            => 'Base Boolean coercion';
103is 0+$obj, 42                       => 'Base Numeric coercion';
104is "$obj", 'hello world'            => 'Base String coercion';
105
106is \&{$obj}, \&global_sub           => 'Base Code coercion';
107is \*{$obj}, \*global_glob          => 'Base Glob coercion';
108is \%{$obj}, \%global_hash          => 'Base Hash coercion';
109is \@{$obj}, \@global_array         => 'Base Array coercion';
110is \${$obj}, \$global_scalar        => 'Base Scalar coercion';
111
112
113# Inheriting coercions...
114
115$obj = DerClass->new();
116
117ok !$obj                            => 'Der Boolean coercion';
118is 0+$obj, 42                       => 'Der Numeric coercion';
119is "$obj", 'hello world'            => 'Der String coercion';
120
121is \&{$obj}, \&global_sub           => 'Der Code coercion';
122is \*{$obj}, \*global_glob          => 'Der Glob coercion';
123is \%{$obj}, \%global_hash          => 'Der Hash coercion';
124is \@{$obj}, \@global_array         => 'Der Array coercion';
125is \${$obj}, \$global_scalar        => 'Der Scalar coercion';
126
127
128# Redefining coercions on inheritance...
129
130$obj = DerClass2->new();
131
132ok $obj                             => 'Der2 Boolean coercion';
133is 0+$obj, 86                       => 'Der2 Numeric coercion';
134is "$obj", 'goodbye world'          => 'Der2 String coercion';
135
136is \&{$obj}, \&global_sub2          => 'Der2 Code coercion';
137is \*{$obj}, \*global_glob2         => 'Der2 Glob coercion';
138is \%{$obj}, \%global_hash2         => 'Der2 Hash coercion';
139is \@{$obj}, \@global_array2        => 'Der2 Array coercion';
140is \${$obj}, \$global_scalar2       => 'Der2 Scalar coercion';
141
142
143# Redefining coercions on inheritance and there is no "use Class::Std" 
144# in the subclass
145
146$obj = DerClass3->new();
147
148ok $obj                             => 'Der3 Boolean coercion';
149is 0+$obj, 86                       => 'Der3 Numeric coercion';
150is "$obj", 'goodbye world'          => 'Der3 String coercion';
151
152is \&{$obj}, \&global_sub2          => 'Der3 Code coercion';
153is \*{$obj}, \*global_glob2         => 'Der3 Glob coercion';
154is \%{$obj}, \%global_hash2         => 'Der3 Hash coercion';
155is \@{$obj}, \@global_array2        => 'Der3 Array coercion';
156is \${$obj}, \$global_scalar2       => 'Der3 Scalar coercion';
157
158
159# The subclass doesn't need to specify the coercions again
160
161$obj = DerClass4->new();
162
163ok $obj                             => 'Der4 Boolean coercion';
164is 0+$obj, 86                       => 'Der4 Numeric coercion';
165is "$obj", 'goodbye world'          => 'Der4 String coercion';
166
167is \&{$obj}, \&global_sub2          => 'Der4 Code coercion';
168is \*{$obj}, \*global_glob2         => 'Der4 Glob coercion';
169is \%{$obj}, \%global_hash2         => 'Der4 Hash coercion';
170is \@{$obj}, \@global_array2        => 'Der4 Array coercion';
171is \${$obj}, \$global_scalar2       => 'Der4 Scalar coercion';
172
173
174# The subclass doesn't need to specify the coercions again
175
176$obj = DerClass5->new();
177
178ok $obj                             => 'Der5 Boolean coercion';
179is 0+$obj, 86                       => 'Der5 Numeric coercion';
180is "$obj", 'goodbye world'          => 'Der5 String coercion';
181
182is \&{$obj}, \&global_sub2          => 'Der5 Code coercion';
183is \*{$obj}, \*global_glob2         => 'Der5 Glob coercion';
184is \%{$obj}, \%global_hash2         => 'Der5 Hash coercion';
185is \@{$obj}, \@global_array2        => 'Der5 Array coercion';
186is \${$obj}, \$global_scalar2       => 'Der5 Scalar coercion';
187