1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
|
#!/usr/bin/perl
# $Id: attr.t 682 2004-09-28 05:59:10Z theory $
##############################################################################
# Set up the tests.
##############################################################################
use strict;
use Test::More tests => 44;
##############################################################################
# Create a simple class.
##############################################################################
package Class::Meta::TestPerson;
use strict;
# Make sure we can load Class::Meta.
BEGIN {
main::use_ok( 'Class::Meta' );
main::use_ok( 'Class::Meta::Types::String' );
}
BEGIN {
# Import Test::More functions into this package.
Test::More->import;
# Create a new Class::Meta object.
ok( my $c = Class::Meta->new(key => 'person'),
"Create CM object" );
isa_ok($c, 'Class::Meta');
# Create an attribute.
sub inst { bless {} }
ok( my $attr = $c->add_attribute( name => 'inst',
type => 'string',
desc => 'The inst attribute',
label => 'inst Attribute',
view => Class::Meta::PUBLIC ),
"Create 'inst' attr");
isa_ok($attr, 'Class::Meta::Attribute');
# Test its accessors.
is( $attr->name, "inst", "Check inst name" );
is( $attr->desc, "The inst attribute", "Check inst desc" );
is( $attr->label, "inst Attribute", "Check inst label" );
is( $attr->type, "string", "Check inst type" );
ok( $attr->view == Class::Meta::PUBLIC, "Check inst view" );
# Okay, now test to make sure that an attempt to create a attribute
# directly fails.
eval { my $attr = Class::Meta::Attribute->new };
ok( my $err = $@, "Get attribute construction exception");
like( $err, qr/Package 'Class::Meta::TestPerson' cannot create/,
"Caught proper exception");
# Now try it without a name.
eval{ $c->add_attribute() };
ok( $err = $@, "Caught no name exception");
like( $err, qr/Parameter 'name' is required in call to new/,
"Caught proper no name exception");
# Try a duplicately-named attribute.
eval{ $c->add_attribute(name => 'inst') };
ok( $err = $@, "Caught dupe name exception");
like( $err, qr/Attribute 'inst' already exists in class/,
"Caught proper dupe name exception");
# Try a couple of bogus visibilities.
eval { $c->add_attribute( name => 'new_attr',
view => 25) };
ok( $err = $@, "Caught bogus view exception");
like( $err, qr/Not a valid view parameter: '25'/,
"Caught proper bogus view exception");
eval { $c->add_attribute( name => 'new_attr',
view => 10) };
ok( $err = $@, "Caught another bogus view exception");
like( $err, qr/Not a valid view parameter: '10'/,
"Caught another proper bogus view exception");
# Try a bogus caller.
eval { $c->add_method( name => 'new_inst',
caller => 'foo' ) };
ok( $err = $@, "Caught bogus caller exception");
like( $err, qr/Parameter caller must be a code reference/,
"Caught proper bogus caller exception");
# Now test all of the defaults.
sub new_attr { 22 }
ok( $attr = $c->add_attribute( name => 'new_attr' ), "Create 'new_attr'" );
isa_ok($attr, 'Class::Meta::Attribute');
# Test its accessors.
is( $attr->name, "new_attr", "Check new_attr name" );
ok( ! defined $attr->desc, "Check new_attr desc" );
ok( ! defined $attr->label, "Check new_attr label" );
ok( $attr->view == Class::Meta::PUBLIC, "Check new_attr view" );
}
# Now try subclassing Class::Meta.
package Class::Meta::SubClass;
use base 'Class::Meta';
sub add_attribute {
Class::Meta::Attribute->new( shift->SUPER::class, @_);
}
package Class::Meta::AnotherTest;
use strict;
BEGIN {
# Import Test::More functions into this package.
Test::More->import;
# Create a new Class::Meta object.
ok( my $c = Class::Meta::SubClass->new
(another => __PACKAGE__), "Create subclassed CM object" );
isa_ok($c, 'Class::Meta');
isa_ok($c, 'Class::Meta::SubClass');
sub foo_attr { bless {} }
ok( my $attr = $c->add_attribute( name => 'foo_attr'),
'Create subclassed foo_attr' );
isa_ok($attr, 'Class::Meta::Attribute');
# Test its accessors.
is( $attr->name, "foo_attr", "Check new foo_attr name" );
ok( ! defined $attr->desc, "Check new foo_attr desc" );
ok( ! defined $attr->label, "Check new foo_attr label" );
ok( $attr->view == Class::Meta::PUBLIC, "Check new foo_attr view" );
}
##############################################################################
# Now try subclassing Class::Meta::Attribute.
package Class::Meta::Attribute::Sub;
use base 'Class::Meta::Attribute';
# Make sure we can override new and build.
sub new { shift->SUPER::new(@_) }
sub build { shift->SUPER::build(@_) }
sub foo { shift->{foo} }
package main;
ok( my $cm = Class::Meta->new(
attribute_class => 'Class::Meta::Attribute::Sub',
), "Create Class" );
ok( my $attr = $cm->add_attribute(name => 'foo', foo => 'bar'),
"Add foo attribute" );
isa_ok($attr, 'Class::Meta::Attribute::Sub');
isa_ok($attr, 'Class::Meta::Attribute');
is( $attr->name, 'foo', "Check an attibute");
is( $attr->foo, 'bar', "Check added attribute" );
|
