« back to all changes in this revision
Viewing changes to t/view_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/view_affordance.t
1
#!perl -w
2
3
# $Id: view_affordance.t 2384 2005-12-14 04:27:23Z theory $
4
5
##############################################################################
6
# Set up the tests.
7
##############################################################################
8
9
use strict;
10
use Test::More tests => 209;
11
12
##############################################################################
13
# Create a simple class.
14
##############################################################################
15
16
package Class::Meta::Test;
17
use strict;
18
19
BEGIN {
20
Test::More->import;
21
use_ok('Class::Meta');
22
use_ok('Class::Meta::Types::Numeric', 'affordance');
23
use_ok('Class::Meta::Types::String', 'affordance');
24
}
25
26
BEGIN {
27
ok( my $c = Class::Meta->new(
28
key => 'person',
29
package => __PACKAGE__,
30
trust => 'Class::Meta::TrustMe',
31
name => 'Class::Meta::TestPerson Class',
32
desc => 'Special person class just for testing Class::Meta.',
33
), "Create Class::Meta object" );
34
35
# Add a constructor.
36
ok( $c->add_constructor( name => 'new',
37
create => 1 ),
38
"Add new constructor" );
39
40
# Add a couple of attributes with created methods.
41
ok( $c->add_attribute( name => 'id',
42
view => Class::Meta::PUBLIC,
43
type => 'integer',
44
label => 'ID',
45
required => 1,
46
default => 22,
47
),
48
"Add id attribute" );
49
ok( $c->add_attribute( name => 'name',
50
view => Class::Meta::PROTECTED,
51
type => 'string',
52
label => 'Name',
53
required => 1,
54
default => '',
55
),
56
"Add protected name attribute" );
57
ok( $c->add_attribute( name => 'age',
58
view => Class::Meta::PRIVATE,
59
type => 'integer',
60
label => 'Age',
61
desc => "The person's age.",
62
required => 0,
63
default => 0,
64
),
65
"Add private age attribute" );
66
ok( $c->add_attribute( name => 'sn',
67
view => Class::Meta::TRUSTED,
68
type => 'string',
69
label => 'SN',
70
desc => "The person's serial number.",
71
required => 0,
72
default => '',
73
),
74
"Add trusted sn attribute" );
75
$c->build;
76
}
77
78
##############################################################################
79
# From within the package, the private and public attributes should just work.
80
##############################################################################
81
82
ok( my $obj = __PACKAGE__->new, "Create new object" );
83
ok( my $class = __PACKAGE__->my_class, "Get class object" );
84
is_deeply( [map { $_->name } $class->attributes], [qw(id name age sn)],
85
'Call to attributes() should return all attributes' );
86
87
# Check id public attribute.
88
is( $obj->get_id, 22, 'Check default ID' );
89
ok( $obj->set_id(12), "Set ID" );
90
is( $obj->get_id, 12, 'Check 12 ID' );
91
ok( my $attr = $class->attributes('id'), 'Get "id" attribute object' );
92
is( $attr->get($obj), 12, "Check indirect 12 ID" );
93
ok( $attr->set($obj, 15), "Indirectly set ID" );
94
is( $attr->get($obj), 15, "Check indirect 15 ID" );
95
96
# Check name protected attribute succeeds.
97
is( $obj->get_name, '', 'Check empty name' );
98
ok( $obj->set_name('Larry'), "Set name" );
99
is( $obj->get_name, 'Larry', 'Check "Larry" name' );
100
ok( $attr = $class->attributes('name'), 'Get "name" attribute object' );
101
is( $attr->get($obj), 'Larry', 'Check indirect "Larry" name' );
102
ok( $attr->set($obj, 'Chip'), "Indirectly set name" );
103
is( $attr->get($obj), 'Chip', 'Check indirect "chip" name' );
104
105
# Check age private attribute succeeds.
106
is( $obj->get_age, 0, 'Check default age' );
107
ok( $obj->set_age(42), "Set age" );
108
is( $obj->get_age, 42, 'Check 42 age' );
109
ok( $attr = $class->attributes('age'), 'Get "age" attribute object' );
110
is( $attr->get($obj), 42, "Check indirect 12 age" );
111
ok( $attr->set($obj, 15), "Indirectly set age" );
112
is( $attr->get($obj), 15, "Check indirect 15 age" );
113
114
# Check sn trusted attribute succeeds.
115
is( $obj->get_sn, '', 'Check empty sn' );
116
ok( $obj->set_sn('123456789'), "Set sn" );
117
is( $obj->get_sn, '123456789', 'Check "123456789" sn' );
118
ok( $attr = $class->attributes('sn'), 'Get "sn" attribute object' );
119
is( $attr->get($obj), '123456789', 'Check indirect "123456789" sn' );
120
ok( $attr->set($obj, '987654321'), "Indirectly set sn" );
121
is( $attr->get($obj), '987654321', 'Check indirect "987654321" sn' );
122
123
# Make sure that we can set all of the attributes via new().
124
ok( $obj = __PACKAGE__->new( id => 10,
125
name => 'Damian',
126
sn => 'au',
127
age => 35),
128
"Create another new object" );
129
130
is( $obj->get_id, 10, 'Check 10 ID' );
131
is( $obj->get_name, 'Damian', 'Check Damian name' );
132
is( $obj->get_age, 35, 'Check 35 age' );
133
is( $obj->get_sn, 'au', 'Check sn is "au"');
134
135
# Do the same with the constructor object.
136
ok( my $ctor = $class->constructors('new'), 'Get "new" constructor object' );
137
ok( $obj = $ctor->call(__PACKAGE__,
138
id => 10,
139
name => 'Damian',
140
sn => 'au',
141
age => 35),
142
"Create another new object" );
143
144
is( $obj->get_id, 10, 'Check 10 ID' );
145
is( $obj->get_name, 'Damian', 'Check Damian name' );
146
is( $obj->get_age, 35, 'Check 35 age' );
147
is( $obj->get_sn, 'au', 'Check sn is "au"');
148
149
##############################################################################
150
# Set up an inherited package.
151
##############################################################################
152
package Class::Meta::Testarama;
153
use strict;
154
use base 'Class::Meta::Test';
155
156
BEGIN {
157
Test::More->import;
158
Class::Meta->new(key => 'testarama')->build;
159
}
160
161
ok( $obj = __PACKAGE__->new, "Create new Testarama object" );
162
ok( $class = __PACKAGE__->my_class, "Get Testarama class object" );
163
is_deeply( [map { $_->name } $class->attributes], [qw(id name)],
164
"Call to attributes() should return public and protected attrs" );
165
166
# Check id public attribute.
167
is( $obj->get_id, 22, 'Check default ID' );
168
ok( $obj->set_id(12), "Set ID" );
169
is( $obj->get_id, 12, 'Check 12 ID' );
170
ok( $attr = $class->attributes('id'), 'Get "id" attribute object' );
171
is( $attr->get($obj), 12, "Check indirect 12 ID" );
172
ok( $attr->set($obj, 15), "Indirectly set ID" );
173
is( $attr->get($obj), 15, "Check indirect 15 ID" );
174
175
# Check name protected attribute succeeds.
176
is( $obj->get_name, '', 'Check empty name' );
177
ok( $obj->set_name('Larry'), "Set name" );
178
is( $obj->get_name, 'Larry', 'Check Larry name' );
179
ok( $attr = $class->attributes('name'), 'Get "name" attribute object' );
180
is( $attr->get($obj), 'Larry', 'Check indirect "Larry" name' );
181
ok( $attr->set($obj, 'Chip'), "Indirectly set name" );
182
is( $attr->get($obj), 'Chip', 'Check indirect "chip" name' );
183
184
# Check age private attribute
185
eval { $obj->set_age(12) };
186
ok( my $err = $@, 'Catch private exception');
187
like( $err, qr/age is a private attribute of Class::Meta::Test/,
188
'Correct private exception');
189
eval { $obj->get_age };
190
ok( $err = $@, 'Catch another private exception');
191
like( $err, qr/age is a private attribute of Class::Meta::Test/,
192
'Correct private exception again');
193
194
# Check that age fails when accessed indirectly, too.
195
ok( $attr = $class->attributes('age'), 'Get "age" attribute object' );
196
eval { $attr->set($obj, 12) };
197
ok( $err = $@, 'Catch indirect private exception');
198
like( $err, qr/age is a private attribute of Class::Meta::Test/,
199
'Correct indirectprivate exception');
200
eval { $attr->get($obj) };
201
ok( $err = $@, 'Catch another indirect private exception');
202
like( $err, qr/age is a private attribute of Class::Meta::Test/,
203
'Correct indirect private exception again');
204
205
# Check fail sn trusted attribute
206
eval { $obj->set_sn('foo') };
207
ok( $err = $@, 'Catch private exception');
208
like( $err, qr/sn is a trusted attribute of Class::Meta::Test/,
209
'Correct private exception');
210
eval { $obj->get_sn };
211
ok( $err = $@, 'Catch another private exception');
212
like( $err, qr/sn is a trusted attribute of Class::Meta::Test/,
213
'Correct private exception again');
214
215
# Check that sn fails when accessed indirectly, too.
216
ok( $attr = $class->attributes('sn'), 'Get "sn" attribute object' );
217
eval { $attr->set($obj, 'foo') };
218
ok( $err = $@, 'Catch indirect private exception');
219
like( $err, qr/sn is a trusted attribute of Class::Meta::Test/,
220
'Correct indirectprivate exception');
221
eval { $attr->get($obj) };
222
ok( $err = $@, 'Catch another indirect private exception');
223
like( $err, qr/sn is a trusted attribute of Class::Meta::Test/,
224
'Correct indirect private exception again');
225
226
# Make sure that we can set protected attributes via new().
227
ok( $obj = __PACKAGE__->new( id => 10,
228
name => 'Damian'),
229
"Create another new object" );
230
231
is( $obj->get_id, 10, 'Check 10 ID' );
232
is( $obj->get_name, 'Damian', 'Check Damian name' );
233
234
# Make sure that the private attribute fails.
235
eval { __PACKAGE__->new( age => 44 ) };
236
ok( $err = $@, 'Catch constructor private exception');
237
like( $err, qr/age is a private attribute of Class::Meta::Test/,
238
'Correct private constructor exception');
239
240
# Make sure that the trusted attribute fails.
241
eval { __PACKAGE__->new( sn => 'foo' ) };
242
ok( $err = $@, 'Catch constructor trusted exception');
243
like( $err, qr/sn is a trusted attribute of Class::Meta::Test/,
244
'Correct trusted constructor exception');
245
246
# Do the same with the constructor object.
247
ok( $ctor = $class->constructors('new'), 'Get "new" constructor object' );
248
ok( $obj = $ctor->call(__PACKAGE__,
249
id => 10,
250
name => 'Damian'),
251
"Create another new object" );
252
253
is( $obj->get_id, 10, 'Check 10 ID' );
254
is( $obj->get_name, 'Damian', 'Check Damian name' );
255
256
# Make sure that the private attribute fails.
257
eval { $ctor->call(__PACKAGE__, age => 44 ) };
258
ok( $err = $@, 'Catch indirect constructor private exception');
259
like( $err, qr/age is a private attribute of Class::Meta::Test/,
260
'Correct indirect private constructor exception');
261
262
# Make sure that the private attribute fails.
263
eval { $ctor->call(__PACKAGE__, sn => 'foo' ) };
264
ok( $err = $@, 'Catch indirect constructor trusted exception');
265
like( $err, qr/sn is a trusted attribute of Class::Meta::Test/,
266
'Correct indirect trusted constructor exception');
267
268
##############################################################################
269
# Set up a trusted package.
270
##############################################################################
271
package Class::Meta::TrustMe;
272
use strict;
273
274
BEGIN { Test::More->import }
275
276
ok( $obj = Class::Meta::Test->new, "Create new Test object" );
277
ok( $class = Class::Meta::Test->my_class, "Get Test class object" );
278
is_deeply( [map { $_->name } $class->attributes], [qw(id sn)],
279
"Call to attributes() should return public and trusted attrs" );
280
is_deeply( [map { $_->name } Class::Meta::Testarama->my_class->attributes],
281
[qw(id sn)],
282
"Call to inherited attributes() should also return public and protected attrs" );
283
284
# Check id public attribute.
285
is( $obj->get_id, 22, 'Check default ID' );
286
ok( $obj->set_id(12), "Set ID" );
287
is( $obj->get_id, 12, 'Check 12 ID' );
288
ok( $attr = $class->attributes('id'), 'Get "id" attribute object' );
289
is( $attr->get($obj), 12, "Check indirect 12 ID" );
290
ok( $attr->set($obj, 15), "Indirectly set ID" );
291
is( $attr->get($obj), 15, "Check indirect 15 ID" );
292
293
# Check name protected attribute
294
eval { $obj->set_name('foo') };
295
ok( $err = $@, "Catch protected exception");
296
like( $err, qr/name is a protected attribute of Class::Meta::Test/,
297
"Correct protected exception" );
298
eval { $obj->get_name };
299
ok( $err = $@, "Catch another protected exception");
300
like( $err, qr/name is a protected attribute of Class::Meta::Test/,
301
"Another correct protected exception" );
302
303
# Check that name fails when accessed indirectly, too.
304
ok( $attr = $class->attributes('name'), 'Get "name" attribute object' );
305
eval { $attr->set($obj, 'foo') };
306
ok( $err = $@, "Catch indirect protected exception");
307
like( $err, qr/name is a protected attribute of Class::Meta::Test/,
308
"Correct indirect protected exception" );
309
eval { $attr->get($obj, 'foo') };
310
ok( $err = $@, "Catch another indirect protected exception");
311
like( $err, qr/name is a protected attribute of Class::Meta::Test/,
312
"Another correct indirect protected exception" );
313
314
# Check age private attribute
315
eval { $obj->set_age(12) };
316
ok( $err = $@, 'Catch private exception');
317
like( $err, qr/age is a private attribute of Class::Meta::Test/,
318
'Correct private exception');
319
eval { $obj->get_age };
320
ok( $err = $@, 'Catch another private exception');
321
like( $err, qr/age is a private attribute of Class::Meta::Test/,
322
'Correct private exception again');
323
324
# Check that age fails when accessed indirectly, too.
325
ok( $attr = $class->attributes('age'), 'Get "age" attribute object' );
326
eval { $attr->set($obj, 12) };
327
ok( $err = $@, 'Catch indirect private exception');
328
like( $err, qr/age is a private attribute of Class::Meta::Test/,
329
'Correct indirectprivate exception');
330
eval { $attr->get($obj) };
331
ok( $err = $@, 'Catch another indirect private exception');
332
like( $err, qr/age is a private attribute of Class::Meta::Test/,
333
'Correct indirect private exception again');
334
335
# Check sn trusted attribute succeeds.
336
is( $obj->get_sn, '', 'Check empty sn' );
337
ok( $obj->set_sn('123456789'), "Set sn" );
338
is( $obj->get_sn, '123456789', 'Check "123456789" sn' );
339
ok( $attr = $class->attributes('sn'), 'Get "sn" attribute object' );
340
is( $attr->get($obj), '123456789', 'Check indirect "123456789" sn' );
341
ok( $attr->set($obj, '987654321'), "Indirectly set sn" );
342
is( $attr->get($obj), '987654321', 'Check indirect "987654321" sn' );
343
344
# Make sure that sn trusted attribute works for subclasses, too.
345
ok( $obj = Class::Meta::Testarama->new, "Create new Testarama object" );
346
is( $obj->get_sn, '', 'Check empty sn' );
347
ok( $obj->set_sn('123456789'), "Set sn" );
348
is( $obj->get_sn, '123456789', 'Check "123456789" sn' );
349
ok( $attr = $class->attributes('sn'), 'Get "sn" attribute object' );
350
is( $attr->get($obj), '123456789', 'Check indirect "123456789" sn' );
351
ok( $attr->set($obj, '987654321'), "Indirectly set sn" );
352
is( $attr->get($obj), '987654321', 'Check indirect "987654321" sn' );
353
354
# Make sure that we can set trusted attributes via new().
355
ok( $obj = Class::Meta::Test->new( id => 10,
356
sn => 'foo'),
357
"Create another new object" );
358
is( $obj->get_id, 10, 'Check 10 ID' );
359
is( $obj->get_sn, 'foo', 'Check foo sn' );
360
361
# Make sure that the private attribute fails.
362
eval { Class::Meta::Test->new( age => 44 ) };
363
ok( $err = $@, "Catch constructor private exception");
364
like( $err, qr/age is a private attribute of Class::Meta::Test/,
365
"Got the right constructor private exception");
366
367
# Make sure that the protected attribute fails.
368
eval { Class::Meta::Test->new( name => 'Damian' ) };
369
ok( $err = $@, "Catch constructor protected exception");
370
like( $err, qr/name is a protected attribute of Class::Meta::Test/,
371
"Got the right constructor protected exception");
372
373
# Do the same with the new constructor object.
374
ok( $ctor = $class->constructors('new'), 'Get "new" constructor object' );
375
ok( $obj = $ctor->call('Class::Meta::Test',
376
id => 10,
377
sn => 'foo'),
378
"Create another new object" );
379
380
is( $obj->get_id, 10, 'Check 10 ID' );
381
is( $obj->get_sn, 'foo', 'Check foo sn' );
382
383
# Make sure that the private attribute fails.
384
eval { $ctor->call('Class::Meta::Test', age => 44 ) };
385
ok( $err = $@, "Catch indirect constructor private exception");
386
like( $err, qr/age is a private attribute of Class::Meta::Test/,
387
"Got the right indirect constructor private exception");
388
389
# Make sure that the protected attribute fails.
390
eval { $ctor->call('Class::Meta::Test', name => 'Damian' ) };
391
ok( $err = $@, "Catch indirect constructor protected exception");
392
like( $err, qr/name is a protected attribute of Class::Meta::Test/,
393
"Got the right indirect constructor protected exception");
394
395
##############################################################################
396
# Now do test in a completely independent package.
397
##############################################################################
398
package main;
399
400
ok( $obj = Class::Meta::Test->new, "Create new object in main" );
401
ok( $class = Class::Meta::Test->my_class, "Get class object in main" );
402
403
# Make sure we can access id.
404
is( $obj->get_id, 22, 'Check default ID' );
405
ok( $obj->set_id(12), "Set ID" );
406
is( $obj->get_id, 12, 'Check 12 ID' );
407
ok( $attr = $class->attributes('id'), 'Get "id" attribute object' );
408
is( $attr->get($obj), 12, "Check indirect 12 ID" );
409
ok( $attr->set($obj, 15), "Indirectly set ID" );
410
is( $attr->get($obj), 15, "Check indirect 15 ID" );
411
412
# Check name protected attribute
413
eval { $obj->set_name('foo') };
414
ok( $err = $@, 'Catch protected exception');
415
like( $err, qr/name is a protected attribute of Class::Meta::Test/,
416
'Correct protected exception');
417
eval { $obj->get_name };
418
ok( $err = $@, 'Catch another protected exception');
419
like( $err, qr/name is a protected attribute of Class::Meta::Test/,
420
'Correct protected exception again');
421
422
# Check that name fails when accessed indirectly, too.
423
ok( $attr = $class->attributes('name'), 'Get "name" attribute object' );
424
eval { $attr->set($obj, 'foo') };
425
ok( $err = $@, 'Catch indirect protected exception');
426
like( $err, qr/name is a protected attribute of Class::Meta::Test/,
427
'Correct indirectprotected exception');
428
eval { $attr->get($obj) };
429
ok( $err = $@, 'Catch another indirect protected exception');
430
like( $err, qr/name is a protected attribute of Class::Meta::Test/,
431
'Correct indirect protected exception again');
432
433
# Check age private attribute
434
eval { $obj->set_age(12) };
435
ok( $err = $@, 'Catch private exception');
436
like( $err, qr/age is a private attribute of Class::Meta::Test/,
437
'Correct private exception');
438
eval { $obj->get_age };
439
ok( $err = $@, 'Catch another private exception');
440
like( $err, qr/age is a private attribute of Class::Meta::Test/,
441
'Correct private exception again');
442
443
# Check that age fails when accessed indirectly, too.
444
ok( $attr = $class->attributes('age'), 'Get "age" attribute object' );
445
eval { $attr->set($obj, 12) };
446
ok( $err = $@, 'Catch indirect private exception');
447
like( $err, qr/age is a private attribute of Class::Meta::Test/,
448
'Correct indirectprivate exception');
449
eval { $attr->get($obj) };
450
ok( $err = $@, 'Catch another indirect private exception');
451
like( $err, qr/age is a private attribute of Class::Meta::Test/,
452
'Correct indirect private exception again');
453
454
# Check sn trusted attribute
455
eval { $obj->set_sn('foo') };
456
ok( $err = $@, 'Catch private exception');
457
like( $err, qr/sn is a trusted attribute of Class::Meta::Test/,
458
'Correct private exception');
459
eval { $obj->get_sn };
460
ok( $err = $@, 'Catch another private exception');
461
like( $err, qr/sn is a trusted attribute of Class::Meta::Test/,
462
'Correct private exception again');
463
464
# Check that sn fails when accessed indirectly, too.
465
ok( $attr = $class->attributes('sn'), 'Get "sn" attribute object' );
466
eval { $attr->set($obj, 'foo') };
467
ok( $err = $@, 'Catch indirect private exception');
468
like( $err, qr/sn is a trusted attribute of Class::Meta::Test/,
469
'Correct indirectprivate exception');
470
eval { $attr->get($obj) };
471
ok( $err = $@, 'Catch another indirect private exception');
472
like( $err, qr/sn is a trusted attribute of Class::Meta::Test/,
473
'Correct indirect private exception again');
474
475
# Try the constructor with parameters.
476
ok( $obj = Class::Meta::Test->new( id => 1 ), "Create new object with id" );
477
is( $obj->get_id, 1, 'Check 1 ID' );
478
ok( $ctor = $class->constructors('new'), "Get new constructor" );
479
ok( $obj = $ctor->call('Class::Meta::Test', id => 52 ),
480
"Indirectly create new object with id" );
481
is( $obj->get_id, 52, 'Check 52 ID' );
482
483
# Make sure that the protected attribute fails.
484
eval { Class::Meta::Test->new( name => 'foo' ) };
485
ok( $err = $@, 'Catch constructor protected exception');
486
like( $err, qr/name is a protected attribute of Class::Meta::Test/,
487
'Correct protected constructor exception');
488
eval { $ctor->call('Class::Meta::Test', name => 'foo' ) };
489
ok( $err = $@, 'Catch indirect constructor protected exception');
490
like( $err, qr/name is a protected attribute of Class::Meta::Test/,
491
'Correct indirect protected constructor exception');
492
493
# Make sure that the private attribute fails.
494
eval { Class::Meta::Test->new( age => 44 ) };
495
ok( $err = $@, 'Catch constructor private exception');
496
like( $err, qr/age is a private attribute of Class::Meta::Test/,
497
'Correct private constructor exception');
498
eval { $ctor->call('Class::Meta::Test', age => 44 ) };
499
ok( $err = $@, 'Catch indirect constructor private exception');
500
like( $err, qr/age is a private attribute of Class::Meta::Test/,
501
'Correct indirect private constructor exception');
502
Loggerhead is a web-based interface for Breezy
Version: 2.0.1