« back to all changes in this revision
Viewing changes to t/custom_type_maker.t
- browse files at revision 1
- compare with another revision
- download diff
- download tarball
- view history from revision 1
- Committer: Bazaar Package Importer
- Author(s): Krzysztof Krzyzaniak (eloy)
- Date: 2006-01-03 17:29:20 UTC
- Revision ID: james.westby@ubuntu.com-20060103172920-h94p8qrrav90bzq0
Tags: upstream-0.52
Import upstream version 0.52
- files added:
- lib
- lib/Class
- lib/Class/Meta
- lib/Class/Meta/AccessorBuilder
- lib/Class/Meta/Types
- t
added
removed
t/custom_type_maker.t
1
#!/usr/bin/perl -w
2
3
# $Id: custom_type_maker.t 682 2004-09-28 05:59:10Z theory $
4
5
##############################################################################
6
# Set up the tests.
7
##############################################################################
8
9
package Class::Meta::Testing;
10
11
use strict;
12
use Test::More tests => 102;
13
14
BEGIN {
15
use_ok('Class::Meta');
16
use_ok( 'Class::Meta::Type' );
17
our @ISA = qw(Class::Meta::Attribute);
18
}
19
20
my $aname = 'foo';
21
my $i = 0;
22
my ($set, $get, $acc, $mut, $err, $type);
23
my $obj = bless {};
24
my $attr;
25
26
##############################################################################
27
# Create a Class::Meta object. We'll use it to create attributes for testing
28
# the creation of accessors.
29
ok( my $cm = Class::Meta->new, "Create Class::Meta object" );
30
31
##############################################################################
32
# Try creating a type with the bare minimum number of arguments.
33
ok( $type = Class::Meta::Type->add( name => 'Homer Object',
34
key => 'homer',
35
),
36
"Create Homer data type" );
37
38
is( $type, Class::Meta::Type->new('Homer'), 'Check lc conversion on key' );
39
is( $type->key, 'homer', "Check homer key" );
40
is( $type->name, 'Homer Object', "Check homer name" );
41
ok( ! defined $type->check, "Check homer checker" );
42
43
# Check to make sure that the accessor is created properly. Start with a
44
# simple set_ method.
45
ok( $attr = $cm->add_attribute( name => $aname . ++$i, type => 'string'),
46
"Create $aname$i attribute" );
47
ok( $type->build(__PACKAGE__, $attr, Class::Meta::GETSET),
48
"Make simple homer set" );
49
ok( $acc = UNIVERSAL::can(__PACKAGE__, $aname . $i),
50
"homer accessor exists");
51
52
# Test it.
53
my $homer = bless {}, 'Homer';
54
ok( $obj->$acc($homer), "Set homer value" );
55
is( $obj->$acc, $homer, "Check homer value" );
56
57
# Check to make sure that the Attribute class accessor coderefs are getting
58
# created.
59
ok( $set = $type->make_attr_set($attr), "Check homer attr_set" );
60
ok( $get = $type->make_attr_get($attr), "Check homer attr_get" );
61
62
# Make sure they get and set values correctly.
63
is( $get->($obj), $homer, "Check homer getter" );
64
$homer = bless {}, 'Homer';
65
ok( $set->($obj, $homer), "Check homer setter" );
66
is( $get->($obj), $homer, "Check homer getter again" );
67
68
##############################################################################
69
# Try the same thing with undefs.
70
ok( $type = Class::Meta::Type->add( name => 'Bart Object',
71
key => 'bart',
72
check => undef,
73
builder => undef,
74
),
75
"Create Bart data type" );
76
77
is( $type, Class::Meta::Type->new('Bart'), 'Check lc conversion on key' );
78
is( $type->key, 'bart', "Check bart key" );
79
is( $type->name, 'Bart Object', "Check bart name" );
80
ok( ! defined $type->check, "Check bart checker" );
81
82
# Check to make sure that the accessor is created properly. Start with a
83
# simple set_ method.
84
ok( $attr = $cm->add_attribute( name => $aname . ++$i, type => 'string'),
85
"Create $aname$i attribute" );
86
ok( $type->build(__PACKAGE__, $attr, Class::Meta::GETSET),
87
"Make simple bart set" );
88
ok( $acc = UNIVERSAL::can(__PACKAGE__, $aname . $i),
89
"bart accessor exists");
90
91
# Test it.
92
my $bart = bless {}, 'Bart';
93
ok( $obj->$acc($bart), "Set bart value" );
94
is( $obj->$acc, $bart, "Check bart value" );
95
96
# Check to make sure that the Attribute class accessor coderefs are getting
97
# created.
98
ok( $set = $type->make_attr_set($attr), "Check bart attr_set" );
99
ok( $get = $type->make_attr_get($attr), "Check bart attr_get" );
100
101
# Make sure they get and set values correctly.
102
is( $get->($obj), $bart, "Check bart getter" );
103
$bart = bless {}, 'Bart';
104
ok( $set->($obj, $bart), "Check bart setter" );
105
is( $get->($obj), $bart, "Check bart getter again" );
106
107
##############################################################################
108
# Try creating a type with an object type validation check.
109
ok( $type = Class::Meta::Type->add
110
( name => 'Marge Object',
111
key => 'marge',
112
check => 'Marge',
113
), "Create Marge data type" );
114
115
is( $type, Class::Meta::Type->new('Marge'),
116
'Check lc conversion on key' );
117
is( $type->key, 'marge', "Check marge key" );
118
is( $type->name, 'Marge Object', "Check marge name" );
119
foreach my $chk (@{ $type->check }) {
120
is( ref $chk, 'CODE', 'Check marge code');
121
}
122
123
# Check to make sure that the accessor is created properly. Start with a
124
# simple set_ method.
125
ok( $attr = $cm->add_attribute( name => $aname . ++$i, type => 'string'),
126
"Create $aname$i attribute" );
127
ok( $type->build(__PACKAGE__, $attr, Class::Meta::GETSET),
128
"Make simple marge set" );
129
ok( $acc = UNIVERSAL::can(__PACKAGE__, $aname . $i),
130
"marge accessor exists");
131
132
# Test it.
133
my $marge = bless {}, 'Marge';
134
ok( $obj->$acc($marge), "Set marge value" );
135
is( $obj->$acc, $marge, "Check marge value" );
136
137
# Make it fail the checks.
138
eval { $obj->$acc('foo') };
139
ok( $err = $@, "Got invalid marge error" );
140
like( $err, qr/^Value .* is not a valid Marge/,
141
'correct marge exception' );
142
143
# Check to make sure that the Attribute class accessor coderefs are getting
144
# created.
145
ok( $set = $type->make_attr_set($attr), "Check marge attr_set" );
146
ok( $get = $type->make_attr_get($attr), "Check marge attr_get" );
147
148
# Make sure they get and set values correctly.
149
is( $get->($obj), $marge, "Check marge getter" );
150
$marge = bless {}, 'Marge';
151
ok( $set->($obj, $marge), "Check marge setter" );
152
is( $get->($obj), $marge, "Check marge getter again" );
153
154
##############################################################################
155
# Try creating a type with affordance accessors.
156
ok( $type = Class::Meta::Type->add
157
( name => 'Lisa Object',
158
key => 'lisa',
159
builder => 'affordance',
160
), "Create Lisa data type" );
161
162
is( $type, Class::Meta::Type->new('Lisa'),
163
'Check lc conversion on key' );
164
is( $type->key, 'lisa', "Check lisa key" );
165
is( $type->name, 'Lisa Object', "Check lisa name" );
166
ok( ! defined $type->check, "Check lisa checker" );
167
168
# Check to make sure that the accessor is created properly. Start with a
169
# simple set_ method.
170
ok( $attr = $cm->add_attribute( name => $aname . ++$i, type => 'string'),
171
"Create $aname$i attribute" );
172
ok( $type->build(__PACKAGE__, $attr, Class::Meta::GETSET),
173
"Make simple lisa set" );
174
ok( $mut = UNIVERSAL::can(__PACKAGE__, "set_$aname$i"),
175
"Lisa mutator exists");
176
ok( $acc = UNIVERSAL::can(__PACKAGE__, "get_$aname$i"),
177
"Lisa getter exists");
178
179
# Test it.
180
my $lisa = bless {}, 'Lisa';
181
ok( $obj->$mut($lisa), "Set lisa value" );
182
is( $obj->$acc, $lisa, "Check lisa value" );
183
184
# Check to make sure that the Attribute class accessor coderefs are getting
185
# created.
186
ok( $set = $type->make_attr_set($attr), "Check lisa attr_set" );
187
ok( $get = $type->make_attr_get($attr), "Check lisa attr_get" );
188
189
# Make sure they get and set values correctly.
190
is( $get->($obj), $lisa, "Check lisa getter" );
191
$lisa = bless {}, 'Lisa';
192
ok( $set->($obj, $lisa), "Check lisa setter" );
193
is( $get->($obj), $lisa, "Check lisa getter again" );
194
195
##############################################################################
196
# Try creating a type with affordance accessors and an object type validation
197
# check.
198
ok( $type = Class::Meta::Type->add
199
( name => 'Maggie Object',
200
key => 'maggie',
201
check => 'Maggie',
202
builder => 'affordance',
203
), "Create Maggie data type" );
204
205
is( $type, Class::Meta::Type->new('Maggie'),
206
'Check lc conversion on key' );
207
is( $type->key, 'maggie', "Check maggie key" );
208
is( $type->name, 'Maggie Object', "Check maggie name" );
209
foreach my $chk (@{ $type->check }) {
210
is( ref $chk, 'CODE', 'Check maggie code');
211
}
212
213
# Check to make sure that the accessor is created properly. Start with a
214
# simple set_ method.
215
ok( $attr = $cm->add_attribute( name => $aname . ++$i, type => 'string'),
216
"Create $aname$i attribute" );
217
ok( $type->build(__PACKAGE__, $attr, Class::Meta::GETSET),
218
"Make simple maggie set" );
219
ok( $mut = UNIVERSAL::can(__PACKAGE__, "set_$aname$i"),
220
"Maggie mutator exists");
221
ok( $acc = UNIVERSAL::can(__PACKAGE__, "get_$aname$i"),
222
"Maggie getter exists");
223
224
# Test it.
225
my $maggie = bless {}, 'Maggie';
226
ok( $obj->$mut($maggie), "Set maggie value" );
227
is( $obj->$acc, $maggie, "Check maggie value" );
228
229
# Make it fail the checks.
230
eval { $obj->$mut('foo') };
231
ok( $err = $@, "Got invalid maggie error" );
232
like( $err, qr/^Value .* is not a valid Maggie/,
233
'correct maggie exception' );
234
235
# Check to make sure that the Attribute class accessor coderefs are getting
236
# created.
237
ok( $set = $type->make_attr_set($attr), "Check maggie attr_set" );
238
ok( $get = $type->make_attr_get($attr), "Check maggie attr_get" );
239
240
# Make sure they get and set values correctly.
241
is( $get->($obj), $maggie, "Check maggie getter" );
242
$maggie = bless {}, 'Maggie';
243
ok( $set->($obj, $maggie), "Check maggie setter" );
244
is( $get->($obj), $maggie, "Check maggie getter again" );
245
246
##############################################################################
247
# Now try one with the checker doing an isa() call.
248
ok( $type = Class::Meta::Type->add(
249
name => 'FooBar Object',
250
key => 'foobar',
251
check => 'FooBar'
252
), "Create FooBar data type" );
253
254
is( ref $type->check, 'ARRAY', "Check foobar check" );
255
foreach my $check (@{ $type->check }) {
256
is( ref $check, 'CODE', 'Check foobar code');
257
}
258
259
##############################################################################
260
# Now create our own checker.
261
ok( $type = Class::Meta::Type->add(
262
name => 'BarGoo Object',
263
key => 'bargoo',
264
check => sub { 'bargoo' }
265
), "Create BarGoo data type" );
266
267
is( ref $type->check, 'ARRAY', "Check bargoo check" );
268
foreach my $check (@{ $type->check }) {
269
is( ref $check, 'CODE', 'Check bargoo code');
270
}
271
272
##############################################################################
273
# And then try an array of checkers.
274
ok( $type = Class::Meta::Type->add(
275
name => 'Doh Object',
276
key => 'doh',
277
check => [sub { 'doh' }, sub { 'doh!' } ]
278
), "Create Doh data type" );
279
280
is( ref $type->check, 'ARRAY', "Check doh check" );
281
foreach my $check (@{ $type->check }) {
282
is( ref $check, 'CODE', 'Check doh code');
283
}
284
285
##############################################################################
286
# And finally, pass in a bogus value for the check parameter.
287
eval {
288
$type = Class::Meta::Type->add(
289
name => 'Bogus',
290
key => 'bogus',
291
check => { so => 'bogus' }
292
)
293
};
294
ok( $err = $@, "Error for bogus check");
295
like( $err, qr/Paremter 'check' in call to add\(\) must be a code/,
296
"Proper error for bogus check");
297
298
##############################################################################
299
# Okay, now try to trigger errors by not passing in required paramters.
300
eval { $type = Class::Meta::Type->add(name => 'foo') };
301
ok($err = $@, "Error for missing key");
302
like( $err, qr/Parameter 'key' is required/, "Proper error for missing key");
303
304
eval { $type = Class::Meta::Type->add(key => 'foo') };
305
ok($err = $@, "Error for missing name");
306
like( $err, qr/Parameter 'name' is required/,
307
"Proper error for missing name");
308
309
##############################################################################
310
# Now try to create one that exists already.
311
eval { $type = Class::Meta::Type->add(name => 'bart', key => 'bart') };
312
ok($err = $@, "Error for duplicate key");
313
like( $err, qr/Type 'bart' already defined/,
314
"Proper error for duplicate key");
315
316
##############################################################################
317
# And finally, let's try some custom accessor code refs.
Loggerhead is a web-based interface for Breezy
Version: 2.0.1