8 use Class::MOP::Attribute;
10 # most values are static
14 Class::MOP::Attribute->new('$test' => (
15 default => qr/hello (.*)/
17 }, undef, '... no refs for defaults' );
20 Class::MOP::Attribute->new('$test' => (
23 }, undef, '... no refs for defaults' );
26 Class::MOP::Attribute->new('$test' => (
29 }, undef, '... no refs for defaults' );
33 Class::MOP::Attribute->new('$test' => (
36 }, undef, '... no refs for defaults' );
39 Class::MOP::Attribute->new('$test' => (
40 default => bless {} => 'Foo'
42 }, undef, '... no refs for defaults' );
48 Class::MOP::Attribute->new('$test' => (
49 builder => qr/hello (.*)/
51 }, undef, '... no refs for builders' );
54 Class::MOP::Attribute->new('$test' => (
57 }, undef, '... no refs for builders' );
60 Class::MOP::Attribute->new('$test' => (
63 }, undef, '... no refs for builders' );
67 Class::MOP::Attribute->new('$test' => (
70 }, undef, '... no refs for builders' );
73 Class::MOP::Attribute->new('$test' => (
74 builder => bless {} => 'Foo'
76 }, undef, '... no refs for builders' );
79 Class::MOP::Attribute->new('$test' => (
80 builder => 'Foo', default => 'Foo'
82 }, undef, '... no default AND builder' );
86 $undef_attr = Class::MOP::Attribute->new('$test' => (
88 predicate => 'has_test',
90 }, undef, '... undef as a default is okay' );
91 ok($undef_attr->has_default, '... and it counts as an actual default');
92 ok(!Class::MOP::Attribute->new('$test')->has_default,
93 '... but attributes with no default have no default');
95 Class::MOP::Class->create(
97 attributes => [$undef_attr],
100 my $obj = Foo->meta->new_object;
101 ok($obj->has_test, '... and the default is populated');
102 is($obj->meta->get_attribute('$test')->get_value($obj), undef, '... with the right value');
104 is( exception { Foo->meta->make_immutable }, undef, '... and it can be inlined' );
107 ok($obj->has_test, '... and the default is populated');
108 is($obj->meta->get_attribute('$test')->get_value($obj), undef, '... with the right value');
114 { # bad construtor args
116 Class::MOP::Attribute->new();
117 }, undef, '... no name argument' );
119 # These are no longer errors
121 Class::MOP::Attribute->new('');
122 }, undef, '... bad name argument' );
125 Class::MOP::Attribute->new(0);
126 }, undef, '... bad name argument' );
130 my $attr = Class::MOP::Attribute->new('$test');
132 $attr->attach_to_class();
133 }, undef, '... attach_to_class died as expected' );
136 $attr->attach_to_class('Fail');
137 }, undef, '... attach_to_class died as expected' );
140 $attr->attach_to_class(bless {} => 'Fail');
141 }, undef, '... attach_to_class died as expected' );
145 my $attr = Class::MOP::Attribute->new('$test' => (
146 reader => [ 'whoops, this wont work' ]
149 $attr->attach_to_class(Class::MOP::Class->initialize('Foo'));
152 $attr->install_accessors;
153 }, undef, '... bad reader format' );
157 my $attr = Class::MOP::Attribute->new('$test');
160 $attr->_process_accessors('fail', 'my_failing_sub');
161 }, undef, '... cannot find "fail" type generator' );
167 package My::Attribute;
168 our @ISA = ('Class::MOP::Attribute');
169 sub generate_reader_method { eval { die } }
172 my $attr = My::Attribute->new('$test' => (
177 $attr->install_accessors;
178 }, undef, '... failed to generate accessors correctly' );
182 my $attr = Class::MOP::Attribute->new('$test' => (
183 predicate => 'has_test'
186 my $Bar = Class::MOP::Class->create('Bar');
187 isa_ok($Bar, 'Class::MOP::Class');
189 $Bar->add_attribute($attr);
191 can_ok('Bar', 'has_test');
193 is($attr, $Bar->remove_attribute('$test'), '... removed the $test attribute');
195 ok(!Bar->can('has_test'), '... Bar no longer has the "has_test" method');
201 # the next three tests once tested that
202 # the code would fail, but we lifted the
203 # restriction so you can have an accessor
204 # along with a reader/writer pair (I mean
205 # why not really). So now they test that
206 # it works, which is kinda silly, but it
207 # tests the API change, so I keep it.
210 Class::MOP::Attribute->new('$foo', (
214 }, undef, '... can create accessors with reader/writers' );
217 Class::MOP::Attribute->new('$foo', (
221 }, undef, '... can create accessors with reader/writers' );
224 Class::MOP::Attribute->new('$foo', (
229 }, undef, '... can create accessors with reader/writers' );