« back to all changes in this revision
Viewing changes to t/chk_types.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/chk_types.t
1
#!/usr/bin/perl -w
2
3
# $Id: chk_types.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 => 195;
13
BEGIN {
14
$SIG{__DIE__} = \&Carp::confess;
15
use_ok( 'Class::Meta');
16
use_ok( 'Class::Meta::Type');
17
use_ok( 'Class::Meta::Types::Numeric');
18
use_ok( 'Class::Meta::Types::Perl');
19
use_ok( 'Class::Meta::Types::String');
20
use_ok( 'Class::Meta::Types::Boolean');
21
our @ISA = qw(Class::Meta::Attribute);
22
}
23
24
my $obj = bless {};
25
my $aname = 'foo';
26
my $i = 0;
27
my $attr;
28
29
##############################################################################
30
# Create a Class::Meta object. We'll use it to create attributes for testing
31
# the creation of accessors.
32
ok( my $cm = Class::Meta->new, "Create Class::Meta object" );
33
34
##############################################################################
35
# Check string data type.
36
ok( my $type = Class::Meta::Type->new('string'), 'Get string' );
37
is( $type, Class::Meta::Type->new('STRING'), 'Check lc conversion on key' );
38
is( $type->key, 'string', "Check string key" );
39
is( $type->name, 'String', "Check string name" );
40
is( ref $type->check, 'ARRAY', "Check string check" );
41
42
foreach my $chk (@{ $type->check }) {
43
is( ref $chk, 'CODE', 'Check string code');
44
}
45
46
# Check to make sure that the accessor is created properly. Start with a
47
# simple set_ method.
48
ok( $attr = $cm->add_attribute( name => $aname . ++$i, type => 'string'),
49
"Create $aname$i attribute" );
50
ok( $type->build(__PACKAGE__, $attr, Class::Meta::GETSET),
51
"Make simple string set" );
52
ok( my $acc = UNIVERSAL::can(__PACKAGE__, $aname . $i),
53
"String accessor exists");
54
55
# Test it.
56
ok( $obj->$acc('test'), "Set string value" );
57
is( $obj->$acc, 'test', "Check string value" );
58
59
# Make it fail the checks.
60
eval { $obj->$acc([]) };
61
ok( my $err = $@, "Got invalid string error" );
62
like( $err, qr/^Value .* is not a valid string/, 'correct string exception' );
63
64
# Check to make sure that the Attribute class accessor coderefs are getting
65
# created.
66
ok( my $set = $type->make_attr_set($attr), "Check string attr_set" );
67
ok( my $get = $type->make_attr_get($attr), "Check string attr_get" );
68
69
# Make sure they get and set values correctly.
70
is( $get->($obj), 'test', "Check string getter" );
71
ok( $set->($obj, 'bar'), "Check string setter" );
72
is( $get->($obj), 'bar', "Check string getter again" );
73
74
##############################################################################
75
# Check boolean data type.
76
ok( $type = Class::Meta::Type->new('boolean'), 'Get boolean' );
77
is( $type, Class::Meta::Type->new('bool'), 'Check bool alias' );
78
is( $type->key, 'boolean', "Check boolean key" );
79
is( $type->name, 'Boolean', "Check boolean name" );
80
# Boolean is special -- it has no checkers.
81
ok( ! defined $type->check, "Check boolean check" );
82
83
# Check to make sure that the accessor is created properly. Start with a
84
# simple set_ method.
85
ok( $attr = $cm->add_attribute( name => $aname . ++$i, type => 'string'),
86
"Create $aname$i attribute" );
87
ok( $type->build(__PACKAGE__, $attr, Class::Meta::GETSET),
88
"Make simple boolean set" );
89
ok( $acc = UNIVERSAL::can(__PACKAGE__, $aname . $i),
90
"Boolean accessor exists");
91
92
# Test it.
93
ok( $obj->$acc('test'), "Set boolean value" );
94
is( $obj->$acc, 1, "Check boolean value" );
95
96
# And finally, check to make sure that the Attribute class accessor coderefs
97
# are getting created.
98
ok( $set = $type->make_attr_set($attr), "Check boolean attr_set" );
99
ok( $get = $type->make_attr_get($attr), "Check boolean attr_get" );
100
101
# Make sure they get and set values correctly.
102
is( $get->($obj), 1, "Check boolean getter" );
103
$set->($obj, '');
104
is( $get->($obj), 0, "Check boolean getter again" );
105
106
##############################################################################
107
# Check whole data type.
108
ok( $type = Class::Meta::Type->new('whole'), 'Get whole' );
109
is( $type->key, 'whole', "Check whole key" );
110
is( $type->name, 'Whole Number', "Check whole name" );
111
is( ref $type->check, 'ARRAY', "Check whole check" );
112
foreach my $chk (@{ $type->check }) {
113
is( ref $chk, 'CODE', 'Check whole code');
114
}
115
116
# Check to make sure that the accessor is created properly. Start with a
117
# simple set_ method.
118
ok( $attr = $cm->add_attribute( name => $aname . ++$i, type => 'string'),
119
"Create $aname$i attribute" );
120
ok( $type->build(__PACKAGE__, $attr, Class::Meta::GETSET),
121
"Make simple whole set" );
122
ok( $acc = UNIVERSAL::can(__PACKAGE__, $aname . $i), "Whole accessor exists");
123
124
# Test it.
125
ok( $obj->$acc(12), "Set whole value" );
126
is( $obj->$acc, 12, "Check whole value" );
127
128
# Make it fail the checks.
129
eval { $obj->$acc(-12) };
130
ok( $err = $@, "Got invalid whole error" );
131
like( $err, qr/^Value .* is not a valid whole number/,
132
'correct whole exception' );
133
134
# Check to make sure that the Attribute class accessor coderefs are getting
135
# created.
136
ok( $set = $type->make_attr_set($attr), "Check whole attr_set" );
137
ok( $get = $type->make_attr_get($attr), "Check whole attr_get" );
138
139
# Make sure they get and set values correctly.
140
is( $get->($obj), 12, "Check whole getter" );
141
ok( $set->($obj, 100), "Check whole setter" );
142
is( $get->($obj), 100, "Check whole getter again" );
143
144
##############################################################################
145
# Check integer data type.
146
ok( $type = Class::Meta::Type->new('integer'), 'Get integer' );
147
is( $type, Class::Meta::Type->new('int'), 'Check int alias' );
148
is( $type->key, 'integer', "Check integer key" );
149
is( $type->name, 'Integer', "Check integer name" );
150
is( ref $type->check, 'ARRAY', "Check integer check" );
151
foreach my $chk (@{ $type->check }) {
152
is( ref $chk, 'CODE', 'Check integer code');
153
}
154
155
# Check to make sure that the accessor is created properly. Start with a
156
# simple set_ method.
157
ok( $attr = $cm->add_attribute( name => $aname . ++$i, type => 'string'),
158
"Create $aname$i attribute" );
159
ok( $type->build(__PACKAGE__, $attr, Class::Meta::GETSET),
160
"Make simple integer set" );
161
ok( $acc = UNIVERSAL::can(__PACKAGE__, $aname . $i),
162
"Integer accessor exists");
163
164
# Test it.
165
ok( $obj->$acc(12), "Set integer value" );
166
is( $obj->$acc, 12, "Check integer value" );
167
168
# Make it fail the checks.
169
eval { $obj->$acc(12.2) };
170
ok( $err = $@, "Got invalid integer error" );
171
like( $err, qr/^Value .* is not a valid integer/,
172
'correct integer exception' );
173
174
# Check to make sure that the Attribute class accessor coderefs are getting
175
# created.
176
ok( $set = $type->make_attr_set($attr), "Check integer attr_set" );
177
ok( $get = $type->make_attr_get($attr), "Check integer attr_get" );
178
179
# Make sure they get and set values correctly.
180
is( $get->($obj), 12, "Check integer getter" );
181
ok( $set->($obj, -100), "Check integer setter" );
182
is( $get->($obj), -100, "Check integer getter again" );
183
184
##############################################################################
185
# Check decimal data type.
186
ok( $type = Class::Meta::Type->new('decimal'), 'Get decimal' );
187
is( $type, Class::Meta::Type->new('dec'), 'Check dec alias' );
188
is( $type->key, 'decimal', "Check decimal key" );
189
is( $type->name, 'Decimal Number', "Check decimal name" );
190
is( ref $type->check, 'ARRAY', "Check decimal check" );
191
foreach my $chk (@{ $type->check }) {
192
is( ref $chk, 'CODE', 'Check decimal code');
193
}
194
195
# Check to make sure that the accessor is created properly. Start with a
196
# simple set_ method.
197
ok( $attr = $cm->add_attribute( name => $aname . ++$i, type => 'string'),
198
"Create $aname$i attribute" );
199
ok( $type->build(__PACKAGE__, $attr, Class::Meta::GETSET),
200
"Make simple decimal set" );
201
ok( $acc = UNIVERSAL::can(__PACKAGE__, $aname . $i),
202
"Decimal accessor exists");
203
204
# Test it.
205
ok( $obj->$acc(12.2), "Set decimal value" );
206
is( $obj->$acc, 12.2, "Check decimal value" );
207
208
# Make it fail the checks.
209
eval { $obj->$acc('foo') };
210
ok( $err = $@, "Got invalid decimal error" );
211
like( $err, qr/^Value .* is not a valid decimal/,
212
'correct decimal exception' );
213
214
# Check to make sure that the Attribute class accessor coderefs are getting
215
# created.
216
ok( $set = $type->make_attr_set($attr), "Check decimal attr_set" );
217
ok( $get = $type->make_attr_get($attr), "Check decimal attr_get" );
218
219
# Make sure they get and set values correctly.
220
is( $get->($obj), 12.2, "Check decimal getter" );
221
ok( $set->($obj, +100.23), "Check decimal setter" );
222
is( $get->($obj), +100.23, "Check decimal getter again" );
223
224
##############################################################################
225
# Check float data type.
226
ok( $type = Class::Meta::Type->new('float'), 'Get float' );
227
is( $type->key, 'float', "Check float key" );
228
is( $type->name, 'Floating Point Number', "Check float name" );
229
is( ref $type->check, 'ARRAY', "Check float check" );
230
foreach my $chk (@{ $type->check }) {
231
is( ref $chk, 'CODE', 'Check float code');
232
}
233
234
# Check to make sure that the accessor is created properly. Start with a
235
# simple set_ method.
236
ok( $attr = $cm->add_attribute( name => $aname . ++$i, type => 'string'),
237
"Create $aname$i attribute" );
238
ok( $type->build(__PACKAGE__, $attr, Class::Meta::GETSET),
239
"Make simple float set" );
240
ok( $acc = UNIVERSAL::can(__PACKAGE__, $aname . $i),
241
"Float accessor exists");
242
243
# Test it.
244
ok( $obj->$acc(1.23e99), "Set float value" );
245
is( $obj->$acc, 1.23e99, "Check float value" );
246
247
# Make it fail the checks.
248
eval { $obj->$acc('foo') };
249
ok( $err = $@, "Got invalid float error" );
250
like( $err, qr/^Value .* is not a valid float/,
251
'correct float exception' );
252
253
# Check to make sure that the Attribute class accessor coderefs are getting
254
# created.
255
ok( $set = $type->make_attr_set($attr), "Check float attr_set" );
256
ok( $get = $type->make_attr_get($attr), "Check float attr_get" );
257
258
# Make sure they get and set values correctly.
259
is( $get->($obj), 1.23e99, "Check float getter" );
260
ok( $set->($obj, -100.23543), "Check float setter" );
261
is( $get->($obj), -100.23543, "Check float getter again" );
262
263
##############################################################################
264
# Check scalar data type.
265
ok( $type = Class::Meta::Type->new('scalar'), 'Get scalar' );
266
is( $type->key, 'scalar', "Check scalar key" );
267
is( $type->name, 'Scalar', "Check scalar name" );
268
# Scalars aren't validated or convted.
269
ok( ! defined $type->check, "Check scalar check" );
270
271
# Check to make sure that the accessor is created properly. Start with a
272
# simple set_ method.
273
ok( $attr = $cm->add_attribute( name => $aname . ++$i, type => 'string'),
274
"Create $aname$i attribute" );
275
ok( $type->build(__PACKAGE__, $attr, Class::Meta::GETSET),
276
"Make simple scalar set" );
277
ok( $acc = UNIVERSAL::can(__PACKAGE__, $aname . $i),
278
"Scalar accessor exists");
279
280
# Test it.
281
ok( $obj->$acc('foo'), "Set scalar value" );
282
is( $obj->$acc, 'foo', "Check scalar value" );
283
284
# Check to make sure that the Attribute class accessor coderefs are getting
285
# created.
286
ok( $set = $type->make_attr_set($attr), "Check scalar attr_set" );
287
ok( $get = $type->make_attr_get($attr), "Check scalar attr_get" );
288
289
# Make sure they get and set values correctly.
290
is( $get->($obj), 'foo', "Check scalar getter" );
291
ok( $set->($obj, []), "Check scalar setter" );
292
is( ref $get->($obj), 'ARRAY', "Check scalar getter again" );
293
294
##############################################################################
295
# Check scalar reference data type.
296
ok( $type = Class::Meta::Type->new('scalarref'), 'Get scalar ref' );
297
is( $type->key, 'scalarref', "Check scalar ref key" );
298
is( $type->name, 'Scalar Reference', "Check scalar ref name" );
299
is( ref $type->check, 'ARRAY', "Check scalar ref check" );
300
foreach my $chk (@{ $type->check }) {
301
is( ref $chk, 'CODE', 'Check scalar ref code');
302
}
303
304
# Check to make sure that the accessor is created properly. Start with a
305
# simple set_ method.
306
ok( $attr = $cm->add_attribute( name => $aname . ++$i, type => 'string'),
307
"Create $aname$i attribute" );
308
ok( $type->build(__PACKAGE__, $attr, Class::Meta::GETSET),
309
"Make simple scalarref set" );
310
ok( $acc = UNIVERSAL::can(__PACKAGE__, $aname . $i),
311
"Scalarref accessor exists");
312
313
# Test it.
314
my $sref = \"foo";
315
ok( $obj->$acc($sref), "Set scalarref value" );
316
is( $obj->$acc, $sref, "Check scalarref value" );
317
318
# Make it fail the checks.
319
eval { $obj->$acc('foo') };
320
ok( $err = $@, "Got invalid scalarref error" );
321
like( $err, qr/^Value .* is not a valid Scalar Reference/,
322
'correct scalarref exception' );
323
324
# Check to make sure that the Attribute class accessor coderefs are getting
325
# created.
326
ok( $set = $type->make_attr_set($attr), "Check scalarref attr_set" );
327
ok( $get = $type->make_attr_get($attr), "Check scalarref attr_get" );
328
329
# Make sure they get and set values correctly.
330
is( $get->($obj), $sref, "Check scalarref getter" );
331
$sref = \"bar";
332
ok( $set->($obj, $sref), "Check scalarref setter" );
333
is( $get->($obj), $sref, "Check scalarref getter again" );
334
335
##############################################################################
336
# Check array data type.
337
ok( $type = Class::Meta::Type->new('array'), 'Get array' );
338
is( $type, Class::Meta::Type->new('arrayref'), 'Check arrayref alias' );
339
is( $type->key, 'array', "Check array key" );
340
is( $type->name, 'Array Reference', "Check array name" );
341
is( ref $type->check, 'ARRAY', "Check array check" );
342
foreach my $chk (@{ $type->check }) {
343
is( ref $chk, 'CODE', 'Check array code');
344
}
345
346
# Check to make sure that the accessor is created properly. Start with a
347
# simple set_ method.
348
ok( $attr = $cm->add_attribute( name => $aname . ++$i, type => 'string'),
349
"Create $aname$i attribute" );
350
ok( $type->build(__PACKAGE__, $attr, Class::Meta::GETSET),
351
"Make simple arrayref set" );
352
ok( $acc = UNIVERSAL::can(__PACKAGE__, $aname . $i),
353
"Arrayref accessor exists");
354
355
# Test it.
356
my $aref = [1,2,3];
357
ok( $obj->$acc($aref), "Set arrayref value" );
358
is( $obj->$acc, $aref, "Check arrayref value" );
359
360
# Make it fail the checks.
361
eval { $obj->$acc('foo') };
362
ok( $err = $@, "Got invalid arrayref error" );
363
like( $err, qr/^Value .* is not a valid Array Reference/,
364
'correct arrayref exception' );
365
366
# Check to make sure that the Attribute class accessor coderefs are getting
367
# created.
368
ok( $set = $type->make_attr_set($attr), "Check arrayref attr_set" );
369
ok( $get = $type->make_attr_get($attr), "Check arrayref attr_get" );
370
371
# Make sure they get and set values correctly.
372
is( $get->($obj), $aref, "Check arrayref getter" );
373
$aref = [4,5,6];
374
ok( $set->($obj, $aref), "Check arrayref setter" );
375
is( $get->($obj), $aref, "Check arrayref getter again" );
376
377
##############################################################################
378
# Check hash data type.
379
ok( $type = Class::Meta::Type->new('hash'), 'Get hash' );
380
is( $type, Class::Meta::Type->new('hashref'), 'Check hashref alias' );
381
is( $type->key, 'hash', "Check hash key" );
382
is( $type->name, 'Hash Reference', "Check hash name" );
383
is( ref $type->check, 'ARRAY', "Check hash check" );
384
foreach my $chk (@{ $type->check }) {
385
is( ref $chk, 'CODE', 'Check hash code');
386
}
387
388
# Check to make sure that the accessor is created properly. Start with a
389
# simple set_ method.
390
ok( $attr = $cm->add_attribute( name => $aname . ++$i, type => 'string'),
391
"Create $aname$i attribute" );
392
ok( $type->build(__PACKAGE__, $attr, Class::Meta::GETSET),
393
"Make simple hashref set" );
394
ok( $acc = UNIVERSAL::can(__PACKAGE__, $aname . $i),
395
"Hashref accessor exists");
396
397
# Test it.
398
my $href = {};
399
ok( $obj->$acc($href), "Set hashref value" );
400
is( $obj->$acc, $href, "Check hashref value" );
401
402
# Make it fail the checks.
403
eval { $obj->$acc('foo') };
404
ok( $err = $@, "Got invalid hashref error" );
405
like( $err, qr/^Value .* is not a valid Hash Reference/,
406
'correct hashref exception' );
407
408
# Check to make sure that the Attribute class accessor coderefs are getting
409
# created.
410
ok( $set = $type->make_attr_set($attr), "Check hashref attr_set" );
411
ok( $get = $type->make_attr_get($attr), "Check hashref attr_get" );
412
413
# Make sure they get and set values correctly.
414
is( $get->($obj), $href, "Check hashref getter" );
415
$href = { foo => 'bar' };
416
ok( $set->($obj, $href), "Check hashref setter" );
417
is( $get->($obj), $href, "Check hashref getter again" );
418
419
##############################################################################
420
# Check code data type.
421
ok( $type = Class::Meta::Type->new('code'), 'Get code' );
422
is( $type, Class::Meta::Type->new('coderef'), 'Check coderef alias' );
423
is( $type, Class::Meta::Type->new('closure'), 'Check closure alias' );
424
is( $type->key, 'code', "Check code key" );
425
is( $type->name, 'Code Reference', "Check code name" );
426
is( ref $type->check, 'ARRAY', "Check code check" );
427
foreach my $chk (@{ $type->check }) {
428
is( ref $chk, 'CODE', 'Check code code');
429
}
430
431
# Check to make sure that the accessor is created properly. Start with a
432
# simple set_ method.
433
ok( $attr = $cm->add_attribute( name => $aname . ++$i, type => 'string'),
434
"Create $aname$i attribute" );
435
ok( $type->build(__PACKAGE__, $attr, Class::Meta::GETSET),
436
"Make simple coderef set" );
437
ok( $acc = UNIVERSAL::can(__PACKAGE__, $aname . $i),
438
"Coderef accessor exists");
439
440
# Test it.
441
my $cref = sub {};
442
ok( $obj->$acc($cref), "Set coderef value" );
443
is( $obj->$acc, $cref, "Check coderef value" );
444
445
# Make it fail the checks.
446
eval { $obj->$acc('foo') };
447
ok( $err = $@, "Got invalid coderef error" );
448
like( $err, qr/^Value .* is not a valid Code Reference/,
449
'correct coderef exception' );
450
451
# Check to make sure that the Attribute class accessor coderefs are getting
452
# created.
453
ok( $set = $type->make_attr_set($attr), "Check coderef attr_set" );
454
ok( $get = $type->make_attr_get($attr), "Check coderef attr_get" );
455
456
# Make sure they get and set values correctly.
457
is( $get->($obj), $cref, "Check coderef getter" );
458
$cref = sub { 'foo' };
459
ok( $set->($obj, $cref), "Check coderef setter" );
460
is( $get->($obj), $cref, "Check coderef getter again" );
Loggerhead is a web-based interface for Breezy
Version: 2.0.1