« back to all changes in this revision
Viewing changes to t/view.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.t
1
#!perl -w
2
3
# $Id: view.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 $] < 5.008
11
? (skip_all => 'Older Carp lacks @CARP_NOT support')
12
: (tests => 394);
13
use File::Spec;
14
my $fn = File::Spec->catfile('t', 'view.t');
15
16
##############################################################################
17
# Create a simple class.
18
##############################################################################
19
20
package Class::Meta::Test;
21
use strict;
22
23
BEGIN {
24
Test::More->import;
25
use_ok('Class::Meta');
26
use_ok('Class::Meta::Types::Numeric');
27
use_ok('Class::Meta::Types::String');
28
}
29
30
BEGIN {
31
ok( my $c = Class::Meta->new(
32
key => 'person',
33
package => __PACKAGE__,
34
name => 'Class::Meta::TestPerson Class',
35
trust => 'Class::Meta::TrustMe',
36
desc => 'Special person class just for testing Class::Meta.',
37
), "Create Class::Meta object" );
38
39
# Add a constructor.
40
ok( $c->add_constructor( name => 'new',
41
create => 1 ),
42
"Add new constructor" );
43
44
# Add a protected constructor.
45
ok( $c->add_constructor( name => 'prot_new',
46
view => Class::Meta::PROTECTED,
47
create => 1 ),
48
"Add protected constructor" );
49
50
# Add a private constructor.
51
ok( $c->add_constructor( name => 'priv_new',
52
view => Class::Meta::PRIVATE,
53
create => 1 ),
54
"Add private constructor" );
55
56
# Add a trusted constructor.
57
ok( $c->add_constructor( name => 'trust_new',
58
view => Class::Meta::TRUSTED,
59
create => 1 ),
60
"Add trusted constructor" );
61
62
# Add a couple of attributes with created methods.
63
ok( $c->add_attribute( name => 'id',
64
view => Class::Meta::PUBLIC,
65
type => 'integer',
66
label => 'ID',
67
required => 1,
68
default => 22,
69
),
70
"Add id attribute" );
71
ok( $c->add_attribute( name => 'name',
72
view => Class::Meta::PROTECTED,
73
type => 'string',
74
label => 'Name',
75
required => 1,
76
default => '',
77
),
78
"Add protected name attribute" );
79
ok( $c->add_attribute( name => 'age',
80
view => Class::Meta::PRIVATE,
81
type => 'integer',
82
label => 'Age',
83
desc => "The person's age.",
84
required => 0,
85
default => 0,
86
),
87
"Add private age attribute" );
88
ok( $c->add_attribute( name => 'sn',
89
view => Class::Meta::TRUSTED,
90
type => 'string',
91
label => 'SN',
92
desc => "The person's serial number.",
93
required => 0,
94
default => '',
95
),
96
"Add trusted sn attribute" );
97
$c->build;
98
}
99
100
##############################################################################
101
# From within the package, the all attributes should just work.
102
##############################################################################
103
104
ok( my $obj = __PACKAGE__->new, "Create new object" );
105
ok( my $class = __PACKAGE__->my_class, "Get class object" );
106
is_deeply(
107
[map { $_->name } $class->attributes],
108
[qw(id name age sn)],
109
'Call to attributes() should return all attributes'
110
);
111
112
is_deeply(
113
[map { $_->name } $class->constructors],
114
[qw(new prot_new priv_new trust_new)],
115
'Call to constructors() should return all constructors'
116
);
117
118
# Check id public attribute.
119
is( $obj->id, 22, 'Check default ID' );
120
ok( $obj->id(12), "Set ID" );
121
is( $obj->id, 12, 'Check 12 ID' );
122
ok( my $attr = $class->attributes('id'), 'Get "id" attribute object' );
123
is( $attr->get($obj), 12, "Check indirect 12 ID" );
124
ok( $attr->set($obj, 15), "Indirectly set ID" );
125
is( $attr->get($obj), 15, "Check indirect 15 ID" );
126
127
# Check name protected attribute succeeds.
128
is( $obj->name, '', 'Check empty name' );
129
ok( $obj->name('Larry'), "Set name" );
130
is( $obj->name, 'Larry', 'Check "Larry" name' );
131
ok( $attr = $class->attributes('name'), 'Get "name" attribute object' );
132
is( $attr->get($obj), 'Larry', 'Check indirect "Larry" name' );
133
ok( $attr->set($obj, 'Chip'), "Indirectly set name" );
134
is( $attr->get($obj), 'Chip', 'Check indirect "chip" name' );
135
136
# Check age private attribute succeeds.
137
is( $obj->age, 0, 'Check default age' );
138
ok( $obj->age(42), "Set age" );
139
is( $obj->age, 42, 'Check 42 age' );
140
ok( $attr = $class->attributes('age'), 'Get "age" attribute object' );
141
is( $attr->get($obj), 42, "Check indirect 12 age" );
142
ok( $attr->set($obj, 15), "Indirectly set age" );
143
is( $attr->get($obj), 15, "Check indirect 15 age" );
144
145
# Check sn trusted attribute succeeds.
146
is( $obj->sn, '', 'Check empty sn' );
147
ok( $obj->sn('123456789'), "Set sn" );
148
is( $obj->sn, '123456789', 'Check "123456789" sn' );
149
ok( $attr = $class->attributes('sn'), 'Get "sn" attribute object' );
150
is( $attr->get($obj), '123456789', 'Check indirect "123456789" sn' );
151
ok( $attr->set($obj, '987654321'), "Indirectly set sn" );
152
is( $attr->get($obj), '987654321', 'Check indirect "987654321" sn' );
153
154
# Make sure that we can set all of the attributes via new().
155
ok( $obj = __PACKAGE__->new( id => 10,
156
name => 'Damian',
157
sn => 'au',
158
age => 35),
159
"Create another new object" );
160
161
is( $obj->id, 10, 'Check 10 ID' );
162
is( $obj->name, 'Damian', 'Check Damian name' );
163
is( $obj->age, 35, 'Check 35 age' );
164
is( $obj->sn, 'au', 'Check sn is "au"');
165
166
# Do the same with the constructor object.
167
ok( my $ctor = $class->constructors('new'), 'Get "new" constructor object' );
168
ok( $obj = $ctor->call(__PACKAGE__,
169
id => 10,
170
name => 'Damian',
171
sn => 'au',
172
age => 35),
173
"Create another new object" );
174
175
is( $obj->id, 10, 'Check 10 ID' );
176
is( $obj->name, 'Damian', 'Check Damian name' );
177
is( $obj->age, 35, 'Check 35 age' );
178
is( $obj->sn, 'au', 'Check sn is "au"');
179
180
# Make sure that we can set all of the attributes via prot_new().
181
ok( $obj = __PACKAGE__->prot_new( id => 10,
182
name => 'Damian',
183
sn => 'au',
184
age => 35),
185
"Create another prot_new object" );
186
187
is( $obj->id, 10, 'Check 10 ID' );
188
is( $obj->name, 'Damian', 'Check Damian name' );
189
is( $obj->age, 35, 'Check 35 age' )
190
;is( $obj->sn, 'au', 'Check sn is "au"');
191
192
# Do the same with the constructor object.
193
ok( $ctor = $class->constructors('prot_new'),
194
'Get "prot_new" constructor object' );
195
ok( $obj = $ctor->call(__PACKAGE__,
196
id => 10,
197
name => 'Damian',
198
sn => 'au',
199
age => 35),
200
"Create another prot_new object" );
201
202
is( $obj->id, 10, 'Check 10 ID' );
203
is( $obj->name, 'Damian', 'Check Damian name' );
204
is( $obj->age, 35, 'Check 35 age' );
205
is( $obj->sn, 'au', 'Check sn is "au"');
206
207
# Make sure that we can set all of the attributes via priv_new().
208
ok( $obj = __PACKAGE__->priv_new( id => 10,
209
name => 'Damian',
210
sn => 'au',
211
age => 35),
212
"Create another priv_new object" );
213
214
is( $obj->id, 10, 'Check 10 ID' );
215
is( $obj->name, 'Damian', 'Check Damian name' );
216
is( $obj->age, 35, 'Check 35 age' );
217
is( $obj->sn, 'au', 'Check sn is "au"');
218
219
# Do the same with the constructor object.
220
ok( $ctor = $class->constructors('priv_new'),
221
'Get "priv_new" constructor object' );
222
ok( $obj = $ctor->call(__PACKAGE__,
223
id => 10,
224
name => 'Damian',
225
sn => 'au',
226
age => 35),
227
"Create another priv_new object" );
228
229
is( $obj->id, 10, 'Check 10 ID' );
230
is( $obj->name, 'Damian', 'Check Damian name' );
231
is( $obj->age, 35, 'Check 35 age' );
232
is( $obj->sn, 'au', 'Check sn is "au"');
233
234
# Make sure that we can set all of the attributes via trust_new().
235
ok( $obj = __PACKAGE__->trust_new( id => 10,
236
name => 'Damian',
237
sn => 'au',
238
age => 35),
239
"Create another trust_new object" );
240
241
is( $obj->id, 10, 'Check 10 ID' );
242
is( $obj->name, 'Damian', 'Check Damian name' );
243
is( $obj->age, 35, 'Check 35 age' );
244
is( $obj->sn, 'au', 'Check sn is "au"');
245
246
# Do the same with the constructor object.
247
ok( $ctor = $class->constructors('trust_new'),
248
'Get "trust_new" constructor object' );
249
ok( $obj = $ctor->call(__PACKAGE__,
250
id => 10,
251
name => 'Damian',
252
sn => 'au',
253
age => 35),
254
"Create another priv_new object" );
255
256
is( $obj->id, 10, 'Check 10 ID' );
257
is( $obj->name, 'Damian', 'Check Damian name' );
258
is( $obj->age, 35, 'Check 35 age' );
259
is( $obj->sn, 'au', 'Check sn is "au"');
260
261
##############################################################################
262
# Set up an inherited package.
263
##############################################################################
264
package Class::Meta::Testarama;
265
use strict;
266
use base 'Class::Meta::Test';
267
268
BEGIN {
269
Test::More->import;
270
Class::Meta->new(key => 'testarama')->build;
271
}
272
273
ok( $obj = __PACKAGE__->new, "Create new Testarama object" );
274
ok( $class = __PACKAGE__->my_class, "Get Testarama class object" );
275
is_deeply( [map { $_->name } $class->attributes], [qw(id name)],
276
"Call to attributes() should return public and protected attrs" );
277
is_deeply( [map { $_->name } $class->constructors], [qw(new prot_new)],
278
"Call to constructors() should return public and protected ctors" );
279
280
# Check id public attribute.
281
is( $obj->id, 22, 'Check default ID' );
282
ok( $obj->id(12), "Set ID" );
283
is( $obj->id, 12, 'Check 12 ID' );
284
ok( $attr = $class->attributes('id'), 'Get "id" attribute object' );
285
is( $attr->get($obj), 12, "Check indirect 12 ID" );
286
ok( $attr->set($obj, 15), "Indirectly set ID" );
287
is( $attr->get($obj), 15, "Check indirect 15 ID" );
288
289
# Check name protected attribute succeeds.
290
is( $obj->name, '', 'Check empty name' );
291
ok( $obj->name('Larry'), "Set name" );
292
is( $obj->name, 'Larry', 'Check Larry name' );
293
ok( $attr = $class->attributes('name'), 'Get "name" attribute object' );
294
is( $attr->get($obj), 'Larry', 'Check indirect "Larry" name' );
295
ok( $attr->set($obj, 'Chip'), "Indirectly set name" );
296
is( $attr->get($obj), 'Chip', 'Check indirect "chip" name' );
297
298
# Check age private attribute
299
eval { $obj->age(12) };
300
main::chk( 'private exception',
301
qr/age is a private attribute of Class::Meta::Test/);
302
eval { $obj->age };
303
main::chk( 'private exception again',
304
qr/age is a private attribute of Class::Meta::Test/);
305
306
# Check that age fails when accessed indirectly, too.
307
ok( $attr = $class->attributes('age'), 'Get "age" attribute object' );
308
eval { $attr->set($obj, 12) };
309
main::chk('indirect private exception',
310
qr/age is a private attribute of Class::Meta::Test/);
311
eval { $attr->get($obj) };
312
main::chk('another indirect private exception',
313
qr/age is a private attribute of Class::Meta::Test/);
314
315
# Check sn trusted attribute fails.
316
eval { $obj->sn('foo') };
317
main::chk( 'trusted exception',
318
qr/sn is a trusted attribute of Class::Meta::Test/);
319
eval { $obj->sn };
320
main::chk( 'trusted exception again',
321
qr/sn is a trusted attribute of Class::Meta::Test/);
322
323
# Check that sn fails when accessed indirectly, too.
324
ok( $attr = $class->attributes('sn'), 'Get "sn" attribute object' );
325
eval { $attr->set($obj, 'foo') };
326
main::chk('indirect trusted exception',
327
qr/sn is a trusted attribute of Class::Meta::Test/);
328
eval { $attr->get($obj) };
329
main::chk('another indirect trusted exception',
330
qr/sn is a trusted attribute of Class::Meta::Test/);
331
332
# Make sure that we can set protected attributes via new().
333
ok( $obj = __PACKAGE__->new( id => 10,
334
name => 'Damian'),
335
"Create another new object" );
336
337
is( $obj->id, 10, 'Check 10 ID' );
338
is( $obj->name, 'Damian', 'Check Damian name' );
339
340
# Make sure that the private attribute fails.
341
$ENV{FOO} = 1;
342
eval { __PACKAGE__->new( age => 44 ) };
343
delete $ENV{FOO};
344
main::chk('constructor private exception',
345
qr/age is a private attribute of Class::Meta::Test/);
346
347
# Do the same with the new constructor object.
348
ok( $ctor = $class->constructors('new'), 'Get "new" constructor object' );
349
ok( $obj = $ctor->call(__PACKAGE__,
350
id => 10,
351
name => 'Damian'),
352
"Create another new object" );
353
354
is( $obj->id, 10, 'Check 10 ID' );
355
is( $obj->name, 'Damian', 'Check Damian name' );
356
357
# Make sure that the private attribute fails.
358
eval { $ctor->call(__PACKAGE__, age => 44 ) };
359
main::chk('indirect constructor private exception',
360
qr/age is a private attribute of Class::Meta::Test/);
361
362
# Make sure that we can set protected attributes via prot_new().
363
ok( $obj = __PACKAGE__->prot_new( id => 10,
364
name => 'Damian'),
365
"Create another prot_new object" );
366
367
is( $obj->id, 10, 'Check 10 ID' );
368
is( $obj->name, 'Damian', 'Check Damian name' );
369
370
# Make sure that the private attribute fails.
371
eval { __PACKAGE__->prot_new( age => 44 ) };
372
main::chk('constructor private exception',
373
qr/age is a private attribute of Class::Meta::Test/);
374
375
# Do the same with the prot_new constructor object.
376
ok( $ctor = $class->constructors('prot_new'),
377
'Get "prot_new" constructor object' );
378
ok( $obj = $ctor->call(__PACKAGE__,
379
id => 10,
380
name => 'Damian'),
381
"Create another prot_new object" );
382
383
is( $obj->id, 10, 'Check 10 ID' );
384
is( $obj->name, 'Damian', 'Check Damian name' );
385
386
# Make sure that the private attribute fails.
387
eval { $ctor->call(__PACKAGE__, age => 44 ) };
388
main::chk('indirect constructor private exception',
389
qr/age is a private attribute of Class::Meta::Test/);
390
391
# Make sure that the private constructor fails.
392
eval { __PACKAGE__->priv_new };
393
main::chk('priv_new exeption',
394
qr/priv_new is a private constructor of Class::Meta::Test/);
395
396
# Make sure the same is true of the priv_new constructor object.
397
ok( $ctor = $class->constructors('priv_new'),
398
'Get "priv_new" constructor object' );
399
eval { $ctor->call(__PACKAGE__) };
400
main::chk('indirect priv_new exeption',
401
qr/priv_new is a private constructor of Class::Meta::Test/);
402
403
##############################################################################
404
# Set up a trusted package.
405
##############################################################################
406
package Class::Meta::TrustMe;
407
use strict;
408
409
BEGIN { Test::More->import }
410
411
ok( $obj = Class::Meta::Test->new, "Create new Test object" );
412
ok( $class = Class::Meta::Test->my_class, "Get Test class object" );
413
is_deeply( [map { $_->name } $class->attributes], [qw(id sn)],
414
"Call to attributes() should return public and trusted attrs" );
415
is_deeply(
416
[map { $_->name } Class::Meta::Testarama->my_class->attributes],
417
[qw(id sn)],
418
'Call to attributes() should return public and trusted attrs',
419
);
420
421
is_deeply(
422
[map { $_->name } Class::Meta::Testarama->my_class->constructors],
423
[qw(new trust_new)],
424
'Call to constructors() should return public and trusted ctors',
425
);
426
427
# Check id public attribute.
428
is( $obj->id, 22, 'Check default ID' );
429
ok( $obj->id(12), "Set ID" );
430
is( $obj->id, 12, 'Check 12 ID' );
431
ok( $attr = $class->attributes('id'), 'Get "id" attribute object' );
432
is( $attr->get($obj), 12, "Check indirect 12 ID" );
433
ok( $attr->set($obj, 15), "Indirectly set ID" );
434
is( $attr->get($obj), 15, "Check indirect 15 ID" );
435
436
# Check name protected attribute
437
eval { $obj->name('foo') };
438
main::chk('protected exception',
439
qr/name is a protected attribute of Class::Meta::Test/);
440
eval { $obj->name };
441
main::chk('another protected exception',
442
qr/name is a protected attribute of Class::Meta::Test/);
443
444
# Check that name fails when accessed indirectly, too.
445
ok( $attr = $class->attributes('name'), 'Get "name" attribute object' );
446
eval { $attr->set($obj, 'foo') };
447
main::chk('indirect protected exception',
448
qr/name is a protected attribute of Class::Meta::Test/);
449
eval { $attr->get($obj) };
450
main::chk('another indirect protected exception',
451
qr/name is a protected attribute of Class::Meta::Test/);
452
453
# Check age private attribute
454
eval { $obj->age(12) };
455
main::chk( 'private exception',
456
qr/age is a private attribute of Class::Meta::Test/);
457
eval { $obj->age };
458
main::chk( 'private exception again',
459
qr/age is a private attribute of Class::Meta::Test/);
460
461
# Check that age fails when accessed indirectly, too.
462
ok( $attr = $class->attributes('age'), 'Get "age" attribute object' );
463
eval { $attr->set($obj, 12) };
464
main::chk('indirect private exception',
465
qr/age is a private attribute of Class::Meta::Test/);
466
eval { $attr->get($obj) };
467
main::chk('another indirect private exception',
468
qr/age is a private attribute of Class::Meta::Test/);
469
470
# Check sn trusted attribute succeeds.
471
is( $obj->sn, '', 'Check empty sn' );
472
ok( $obj->sn('123456789'), "Set sn" );
473
is( $obj->sn, '123456789', 'Check "123456789" sn' );
474
ok( $attr = $class->attributes('sn'), 'Get "sn" attribute object' );
475
is( $attr->get($obj), '123456789', 'Check indirect "123456789" sn' );
476
ok( $attr->set($obj, '987654321'), "Indirectly set sn" );
477
is( $attr->get($obj), '987654321', 'Check indirect "987654321" sn' );
478
479
# Make sure that sn trusted attribute works for subclasses, too.
480
ok( $obj = Class::Meta::Testarama->new, "Create new Testarama object" );
481
is( $obj->sn, '', 'Check empty sn' );
482
ok( $obj->sn('123456789'), "Set sn" );
483
is( $obj->sn, '123456789', 'Check "123456789" sn' );
484
ok( $attr = $class->attributes('sn'), 'Get "sn" attribute object' );
485
is( $attr->get($obj), '123456789', 'Check indirect "123456789" sn' );
486
ok( $attr->set($obj, '987654321'), "Indirectly set sn" );
487
is( $attr->get($obj), '987654321', 'Check indirect "987654321" sn' );
488
489
# Make sure that we can set trusted attributes via new().
490
ok( $obj = Class::Meta::Test->new( id => 10,
491
sn => 'foo'),
492
"Create another new object" );
493
494
is( $obj->id, 10, 'Check 10 ID' );
495
is( $obj->sn, 'foo', 'Check foo sn' );
496
497
# Make sure that the private attribute fails.
498
eval { Class::Meta::Test->new( age => 44 ) };
499
main::chk('constructor private exception',
500
qr/age is a private attribute of Class::Meta::Test/);
501
502
# Make sure that the protected attribute fails.
503
eval { Class::Meta::Test->new( name => 'Damian' ) };
504
main::chk('constructor protected exception',
505
qr/name is a protected attribute of Class::Meta::Test/);
506
507
# Do the same with the new constructor object.
508
ok( $ctor = $class->constructors('new'), 'Get "new" constructor object' );
509
ok( $obj = $ctor->call('Class::Meta::Test',
510
id => 10,
511
sn => 'foo'),
512
"Create another new object" );
513
514
is( $obj->id, 10, 'Check 10 ID' );
515
is( $obj->sn, 'foo', 'Check foo sn' );
516
517
# Make sure that the private attribute fails.
518
eval { $ctor->call('Class::Meta::Test', age => 44 ) };
519
main::chk('indirect constructor private exception',
520
qr/age is a private attribute of Class::Meta::Test/);
521
522
# Make sure that the protected attribute fails.
523
eval { $ctor->call('Class::Meta::Test', name => 'Damian' ) };
524
main::chk('indirect constructor protected exception',
525
qr/name is a protected attribute of Class::Meta::Test/);
526
527
# Make sure that we can set trusted attributes via trust_new().
528
ok( $obj = Class::Meta::Test->trust_new( id => 10,
529
sn => 'foo'),
530
"Create another trust_new object" );
531
532
is( $obj->id, 10, 'Check 10 ID' );
533
is( $obj->sn, 'foo', 'Check foo name' );
534
535
# Make sure that the private attribute fails.
536
eval { Class::Meta::Test->trust_new( age => 44 ) };
537
main::chk('constructor private exception',
538
qr/age is a private attribute of Class::Meta::Test/);
539
540
# Make sure that the protected attribute fails.
541
eval { Class::Meta::Test->trust_new( name => 'Damian' ) };
542
main::chk('constructor protected exception',
543
qr/name is a protected attribute of Class::Meta::Test/);
544
545
# Do the same with the trust_new constructor object.
546
ok( $ctor = $class->constructors('trust_new'),
547
'Get "trust_new" constructor object' );
548
ok( $obj = $ctor->call('Class::Meta::Test',
549
id => 10,
550
sn => 'foo'),
551
"Create another trust_new object" );
552
553
is( $obj->id, 10, 'Check 10 ID' );
554
is( $obj->sn, 'foo', 'Check foo name' );
555
556
# Make sure that the private attribute fails.
557
eval { $ctor->call('Class::Meta::Test', age => 44 ) };
558
main::chk('indirect constructor private exception',
559
qr/age is a private attribute of Class::Meta::Test/);
560
561
# Make sure that the private attribute fails.
562
eval { $ctor->call('Class::Meta::Test', age => 44 ) };
563
main::chk('indirect constructor private exception',
564
qr/age is a private attribute of Class::Meta::Test/);
565
566
# Make sure that the protected constructor fails.
567
eval { Class::Meta::Test->prot_new };
568
main::chk('prot_new exeption',
569
qr/prot_new is a protected constrctor of Class::Meta::Test/);
570
571
# Make sure the same is true of the priv_new constructor object.
572
ok( $ctor = $class->constructors('priv_new'),
573
'Get "priv_new" constructor object' );
574
eval { $ctor->call('Class::Meta::Test') };
575
main::chk('indirect priv_new exeption',
576
qr/priv_new is a private constructor of Class::Meta::Test/);
577
578
##############################################################################
579
# Now do test in a completely independent package.
580
##############################################################################
581
package main;
582
583
ok( $obj = Class::Meta::Test->new, "Create new object in main" );
584
ok( $class = Class::Meta::Test->my_class, "Get class object in main" );
585
586
# Make sure we can access id.
587
is( $obj->id, 22, 'Check default ID' );
588
ok( $obj->id(12), "Set ID" );
589
is( $obj->id, 12, 'Check 12 ID' );
590
ok( $attr = $class->attributes('id'), 'Get "id" attribute object' );
591
is( $attr->get($obj), 12, "Check indirect 12 ID" );
592
ok( $attr->set($obj, 15), "Indirectly set ID" );
593
is( $attr->get($obj), 15, "Check indirect 15 ID" );
594
595
# Check name protected attribute
596
eval { $obj->name('foo') };
597
chk('protected exception',
598
qr/name is a protected attribute of Class::Meta::Test/);
599
eval { $obj->name };
600
chk('another protected exception',
601
qr/name is a protected attribute of Class::Meta::Test/);
602
603
# Check that name fails when accessed indirectly, too.
604
ok( $attr = $class->attributes('name'), 'Get "name" attribute object' );
605
eval { $attr->set($obj, 'foo') };
606
chk('indirect protected exception',
607
qr/name is a protected attribute of Class::Meta::Test/);
608
eval { $attr->get($obj) };
609
chk('another indirect protected exception',
610
qr/name is a protected attribute of Class::Meta::Test/);
611
612
# Check sn trusted attribute, which can't be accessed by subclasses.
613
eval { $obj->sn('foo') };
614
main::chk( 'trusted exception',
615
qr/sn is a trusted attribute of Class::Meta::Test/);
616
eval { $obj->sn };
617
main::chk( 'trusted exception again',
618
qr/sn is a trusted attribute of Class::Meta::Test/);
619
620
# Check that sn fails when accessed indirectly, too.
621
ok( $attr = $class->attributes('sn'), 'Get "sn" attribute object' );
622
eval { $attr->set($obj, 'foo') };
623
main::chk('indirect trusted exception',
624
qr/sn is a trusted attribute of Class::Meta::Test/);
625
eval { $attr->get($obj) };
626
main::chk('another indirect trusted exception',
627
qr/sn is a trusted attribute of Class::Meta::Test/);
628
629
# Check age private attribute
630
eval { $obj->age(12) };
631
chk( 'private exception',
632
qr/age is a private attribute of Class::Meta::Test/ );
633
eval { $obj->age };
634
chk( 'another private exception',
635
qr/age is a private attribute of Class::Meta::Test/);
636
637
# Check that age fails when accessed indirectly, too.
638
ok( $attr = $class->attributes('age'), 'Get "age" attribute object' );
639
eval { $attr->set($obj, 12) };
640
chk( 'indirect private exception',
641
qr/age is a private attribute of Class::Meta::Test/);
642
eval { $attr->get($obj) };
643
chk( 'another indirect private exception',
644
qr/age is a private attribute of Class::Meta::Test/);
645
646
# Try the constructor with parameters.
647
ok( $obj = Class::Meta::Test->new( id => 1 ), "Create new object with id" );
648
is( $obj->id, 1, 'Check 1 ID' );
649
ok( $ctor = $class->constructors('new'), "Get new constructor" );
650
ok( $obj = $ctor->call('Class::Meta::Test', id => 52 ),
651
"Indirectly create new object with id" );
652
is( $obj->id, 52, 'Check 52 ID' );
653
654
# Make sure that the protected attribute fails.
655
eval { Class::Meta::Test->new( name => 'foo' ) };
656
chk( 'constructor protected exception',
657
qr/name is a protected attribute of Class::Meta::Test/ );
658
eval { $ctor->call('Class::Meta::Test', name => 'foo' ) };
659
chk( 'indirect constructor protected exception',
660
qr/name is a protected attribute of Class::Meta::Test/);
661
662
# Make sure that the private attribute fails.
663
eval { Class::Meta::Test->new( age => 44 ) };
664
chk('constructor private exception',
665
qr/age is a private attribute of Class::Meta::Test/);
666
eval { $ctor->call('Class::Meta::Test', age => 44 ) };
667
chk( 'indirect constructor private exception',
668
qr/age is a private attribute of Class::Meta::Test/);
669
670
# Make sure that the protected constructor fails.
671
eval { Class::Meta::Test->prot_new };
672
chk( 'prot_new exeption',
673
qr/prot_new is a protected constrctor of Class::Meta::Test/ );
674
675
# Make sure the same is true of the prot_new constructor object.
676
ok( $ctor = $class->constructors('prot_new'),
677
'Get "prot_new" constructor object' );
678
eval { $ctor->call(__PACKAGE__) };
679
chk( 'indirect prot_new exeption',
680
qr/prot_new is a protected constrctor of Class::Meta::Test/ );
681
682
# Make sure that the private constructor fails.
683
eval { Class::Meta::Test->priv_new };
684
chk( 'priv_new exeption',
685
qr/priv_new is a private constructor of Class::Meta::Test/ );
686
687
# Make sure the same is true of the priv_new constructor object.
688
ok( $ctor = $class->constructors('priv_new'),
689
'Get "priv_new" constructor object' );
690
eval { $ctor->call(__PACKAGE__) };
691
chk( 'indirect priv_new exeption',
692
qr/priv_new is a private constructor of Class::Meta::Test/ );
693
694
sub chk {
695
my ($name, $qr) = @_;
696
# Catch the exception.
697
ok( my $err = $@, "Caught $name error" );
698
# Check its message.
699
like( $err, $qr, "Correct error" );
700
# Make sure it refers to this file.
701
like( $err, qr/(?:at\s+\Q$fn\E|\Q$fn\E\s+at)\s+line/, 'Correct context' );
702
# Make sure it doesn't refer to other Class::Meta files.
703
unlike( $err, qr|lib/Class/Meta|, 'Not incorrect context')
704
}
Loggerhead is a web-based interface for Breezy
Version: 2.0.1