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