Commit | Line | Data |
38bf2a25 |
1 | use strict; |
2 | use warnings; |
3 | |
4 | use Test::More; |
5 | use Test::Fatal; |
6 | |
7 | { |
8 | package Foo; |
9 | use metaclass; |
10 | sub foo {} |
11 | Foo->meta->add_attribute('bar'); |
12 | } |
13 | |
14 | sub check_meta_sanity { |
15 | my ($meta, $class) = @_; |
16 | isa_ok($meta, 'Class::MOP::Class'); |
17 | is($meta->name, $class); |
18 | ok($meta->has_method('foo')); |
19 | isa_ok($meta->get_method('foo'), 'Class::MOP::Method'); |
20 | ok($meta->has_attribute('bar')); |
21 | isa_ok($meta->get_attribute('bar'), 'Class::MOP::Attribute'); |
22 | } |
23 | |
24 | can_ok('Foo', 'meta'); |
25 | |
26 | my $meta = Foo->meta; |
27 | check_meta_sanity($meta, 'Foo'); |
28 | |
29 | is( exception { |
30 | $meta = $meta->reinitialize($meta->name); |
31 | }, undef ); |
32 | check_meta_sanity($meta, 'Foo'); |
33 | |
34 | is( exception { |
35 | $meta = $meta->reinitialize($meta); |
36 | }, undef ); |
37 | check_meta_sanity($meta, 'Foo'); |
38 | |
39 | like( exception { |
40 | $meta->reinitialize(''); |
41 | }, qr/You must pass a package name or an existing Class::MOP::Package instance/ ); |
42 | |
43 | like( exception { |
44 | $meta->reinitialize($meta->new_object); |
45 | }, qr/You must pass a package name or an existing Class::MOP::Package instance/ ); |
46 | |
47 | { |
48 | package Bar::Meta::Method; |
49 | use base 'Class::MOP::Method'; |
50 | __PACKAGE__->meta->add_attribute('test', accessor => 'test'); |
51 | } |
52 | |
53 | { |
54 | package Bar::Meta::Attribute; |
55 | use base 'Class::MOP::Attribute'; |
56 | __PACKAGE__->meta->add_attribute('tset', accessor => 'tset'); |
57 | } |
58 | |
59 | { |
60 | package Bar; |
61 | use metaclass; |
62 | Bar->meta->add_method('foo' => Bar::Meta::Method->wrap(sub {}, name => 'foo', package_name => 'Bar')); |
63 | Bar->meta->add_attribute(Bar::Meta::Attribute->new('bar')); |
64 | } |
65 | |
66 | $meta = Bar->meta; |
67 | check_meta_sanity($meta, 'Bar'); |
68 | isa_ok(Bar->meta->get_method('foo'), 'Bar::Meta::Method'); |
69 | isa_ok(Bar->meta->get_attribute('bar'), 'Bar::Meta::Attribute'); |
70 | is( exception { |
71 | $meta = $meta->reinitialize('Bar'); |
72 | }, undef ); |
73 | check_meta_sanity($meta, 'Bar'); |
74 | isa_ok(Bar->meta->get_method('foo'), 'Bar::Meta::Method'); |
75 | isa_ok(Bar->meta->get_attribute('bar'), 'Bar::Meta::Attribute'); |
76 | |
77 | Bar->meta->get_method('foo')->test('FOO'); |
78 | Bar->meta->get_attribute('bar')->tset('OOF'); |
79 | |
80 | is(Bar->meta->get_method('foo')->test, 'FOO'); |
81 | is(Bar->meta->get_attribute('bar')->tset, 'OOF'); |
82 | is( exception { |
83 | $meta = $meta->reinitialize('Bar'); |
84 | }, undef ); |
85 | is(Bar->meta->get_method('foo')->test, 'FOO'); |
86 | is(Bar->meta->get_attribute('bar')->tset, 'OOF'); |
87 | |
88 | { |
89 | package Baz::Meta::Attribute; |
90 | use base 'Class::MOP::Attribute'; |
91 | } |
92 | |
93 | { |
94 | package Baz::Meta::Method; |
95 | use base 'Class::MOP::Method'; |
96 | } |
97 | |
98 | { |
99 | package Baz; |
100 | use metaclass meta_name => undef; |
101 | |
102 | sub foo {} |
103 | Class::MOP::class_of('Baz')->add_attribute('bar'); |
104 | } |
105 | |
106 | $meta = Class::MOP::class_of('Baz'); |
107 | check_meta_sanity($meta, 'Baz'); |
108 | ok(!$meta->get_method('foo')->isa('Baz::Meta::Method')); |
109 | ok(!$meta->get_attribute('bar')->isa('Baz::Meta::Attribute')); |
110 | is( exception { |
111 | $meta = $meta->reinitialize( |
112 | 'Baz', |
113 | attribute_metaclass => 'Baz::Meta::Attribute', |
114 | method_metaclass => 'Baz::Meta::Method' |
115 | ); |
116 | }, undef ); |
117 | check_meta_sanity($meta, 'Baz'); |
118 | isa_ok($meta->get_method('foo'), 'Baz::Meta::Method'); |
119 | isa_ok($meta->get_attribute('bar'), 'Baz::Meta::Attribute'); |
120 | |
121 | { |
122 | package Quux; |
123 | use metaclass |
124 | attribute_metaclass => 'Bar::Meta::Attribute', |
125 | method_metaclass => 'Bar::Meta::Method'; |
126 | |
127 | sub foo {} |
128 | Quux->meta->add_attribute('bar'); |
129 | } |
130 | |
131 | $meta = Quux->meta; |
132 | check_meta_sanity($meta, 'Quux'); |
133 | isa_ok(Quux->meta->get_method('foo'), 'Bar::Meta::Method'); |
134 | isa_ok(Quux->meta->get_attribute('bar'), 'Bar::Meta::Attribute'); |
135 | like( exception { |
136 | $meta = $meta->reinitialize( |
137 | 'Quux', |
138 | attribute_metaclass => 'Baz::Meta::Attribute', |
139 | method_metaclass => 'Baz::Meta::Method', |
140 | ); |
141 | }, qr/compatible/ ); |
142 | |
143 | { |
144 | package Quuux::Meta::Attribute; |
145 | use base 'Class::MOP::Attribute'; |
146 | |
147 | sub install_accessors {} |
148 | } |
149 | |
150 | { |
151 | package Quuux; |
152 | use metaclass; |
153 | sub foo {} |
154 | Quuux->meta->add_attribute('bar', reader => 'bar'); |
155 | } |
156 | |
157 | $meta = Quuux->meta; |
158 | check_meta_sanity($meta, 'Quuux'); |
159 | ok($meta->has_method('bar')); |
160 | is( exception { |
161 | $meta = $meta->reinitialize( |
162 | 'Quuux', |
163 | attribute_metaclass => 'Quuux::Meta::Attribute', |
164 | ); |
165 | }, undef ); |
166 | check_meta_sanity($meta, 'Quuux'); |
167 | ok(!$meta->has_method('bar')); |
168 | |
169 | { |
170 | package Blah::Meta::Method; |
171 | use base 'Class::MOP::Method'; |
172 | |
173 | __PACKAGE__->meta->add_attribute('foo', reader => 'foo', default => 'TEST'); |
174 | } |
175 | |
176 | { |
177 | package Blah::Meta::Attribute; |
178 | use base 'Class::MOP::Attribute'; |
179 | |
180 | __PACKAGE__->meta->add_attribute('oof', reader => 'oof', default => 'TSET'); |
181 | } |
182 | |
183 | { |
184 | package Blah; |
185 | use metaclass no_meta => 1; |
186 | sub foo {} |
187 | Class::MOP::class_of('Blah')->add_attribute('bar'); |
188 | } |
189 | |
190 | $meta = Class::MOP::class_of('Blah'); |
191 | check_meta_sanity($meta, 'Blah'); |
192 | is( exception { |
193 | $meta = Class::MOP::Class->reinitialize( |
194 | 'Blah', |
195 | attribute_metaclass => 'Blah::Meta::Attribute', |
196 | method_metaclass => 'Blah::Meta::Method', |
197 | ); |
198 | }, undef ); |
199 | check_meta_sanity($meta, 'Blah'); |
200 | can_ok($meta->get_method('foo'), 'foo'); |
201 | is($meta->get_method('foo')->foo, 'TEST'); |
202 | can_ok($meta->get_attribute('bar'), 'oof'); |
203 | is($meta->get_attribute('bar')->oof, 'TSET'); |
204 | |
205 | done_testing; |