}
sub check_meta_sanity {
- my ($meta) = @_;
+ my ($meta, $class) = @_;
isa_ok($meta, 'Class::MOP::Class');
- is($meta->name, 'Foo');
+ is($meta->name, $class);
ok($meta->has_method('foo'));
+ isa_ok($meta->get_method('foo'), 'Class::MOP::Method');
ok($meta->has_attribute('bar'));
+ isa_ok($meta->get_attribute('bar'), 'Class::MOP::Attribute');
}
can_ok('Foo', 'meta');
my $meta = Foo->meta;
-check_meta_sanity($meta);
+check_meta_sanity($meta, 'Foo');
lives_ok {
$meta = $meta->reinitialize($meta->name);
};
-check_meta_sanity($meta);
+check_meta_sanity($meta, 'Foo');
lives_ok {
$meta = $meta->reinitialize($meta);
};
-check_meta_sanity($meta);
+check_meta_sanity($meta, 'Foo');
throws_ok {
$meta->reinitialize('');
$meta->reinitialize($meta->new_object);
} qr/You must pass a package name or an existing Class::MOP::Package instance/;
+{
+ package Bar::Meta::Method;
+ use base 'Class::MOP::Method';
+ __PACKAGE__->meta->add_attribute('test', accessor => 'test');
+}
+
+{
+ package Bar::Meta::Attribute;
+ use base 'Class::MOP::Attribute';
+ __PACKAGE__->meta->add_attribute('tset', accessor => 'tset');
+}
+
+{
+ package Bar;
+ use metaclass;
+ Bar->meta->add_method('foo' => Bar::Meta::Method->wrap(sub {}, name => 'foo', package_name => 'Bar'));
+ Bar->meta->add_attribute(Bar::Meta::Attribute->new('bar'));
+}
+
+$meta = Bar->meta;
+check_meta_sanity($meta, 'Bar');
+isa_ok(Bar->meta->get_method('foo'), 'Bar::Meta::Method');
+isa_ok(Bar->meta->get_attribute('bar'), 'Bar::Meta::Attribute');
+lives_ok {
+ $meta = $meta->reinitialize('Bar');
+};
+check_meta_sanity($meta, 'Bar');
+isa_ok(Bar->meta->get_method('foo'), 'Bar::Meta::Method');
+isa_ok(Bar->meta->get_attribute('bar'), 'Bar::Meta::Attribute');
+
+Bar->meta->get_method('foo')->test('FOO');
+Bar->meta->get_attribute('bar')->tset('OOF');
+
+is(Bar->meta->get_method('foo')->test, 'FOO');
+is(Bar->meta->get_attribute('bar')->tset, 'OOF');
+lives_ok {
+ $meta = $meta->reinitialize('Bar');
+};
+is(Bar->meta->get_method('foo')->test, 'FOO');
+is(Bar->meta->get_attribute('bar')->tset, 'OOF');
+
+{
+ package Baz::Meta::Attribute;
+ use base 'Class::MOP::Attribute';
+}
+
+{
+ package Baz::Meta::Method;
+ use base 'Class::MOP::Method';
+}
+
+{
+ package Baz;
+ use metaclass;
+
+ sub foo {}
+ Baz->meta->add_attribute('bar');
+}
+
+$meta = Baz->meta;
+check_meta_sanity($meta, 'Baz');
+ok(!Baz->meta->get_method('foo')->isa('Baz::Meta::Method'));
+ok(!Baz->meta->get_attribute('bar')->isa('Baz::Meta::Attribute'));
+lives_ok {
+ $meta = $meta->reinitialize(
+ 'Baz',
+ attribute_metaclass => 'Baz::Meta::Attribute',
+ method_metaclass => 'Baz::Meta::Method'
+ );
+};
+check_meta_sanity($meta, 'Baz');
+isa_ok(Baz->meta->get_method('foo'), 'Baz::Meta::Method');
+isa_ok(Baz->meta->get_attribute('bar'), 'Baz::Meta::Attribute');
+
+{
+ package Quux;
+ use metaclass
+ attribute_metaclass => 'Bar::Meta::Attribute',
+ method_metaclass => 'Bar::Meta::Method';
+
+ sub foo {}
+ Quux->meta->add_attribute('bar');
+}
+
+$meta = Quux->meta;
+check_meta_sanity($meta, 'Quux');
+isa_ok(Quux->meta->get_method('foo'), 'Bar::Meta::Method');
+isa_ok(Quux->meta->get_attribute('bar'), 'Bar::Meta::Attribute');
+throws_ok {
+ $meta = $meta->reinitialize(
+ 'Quux',
+ attribute_metaclass => 'Baz::Meta::Attribute',
+ method_metaclass => 'Baz::Meta::Method',
+ );
+} qr/compatible/;
+
done_testing;