use strict;
use warnings;
-use Test::More tests => 66;
+use lib 't/lib', 'lib';
+
+use Test::More tests => 80;
+use Test::Exception;
use Moose::Util::MetaRole;
{
Moose::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Class',
+ wrapped_method_metaclass_roles => ['Role::Foo'],
+ );
+
+ ok( My::Class->meta()->wrapped_method_metaclass()->meta()->does_role('Role::Foo'),
+ q{apply Role::Foo to My::Class->meta()'s wrapped method metaclass} );
+ ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
+ '... My::Class->meta() still does Role::Foo' );
+ ok( My::Class->meta()->meta()->does_role('Role::Foo'),
+ '... My::Class->meta() still does Role::Foo' );
+ ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
+ q{... My::Class->meta()'s attribute metaclass still does Role::Foo} );
+
+ My::Class->meta()->add_after_method_modifier( 'bar' => sub { 'bar' } );
+ is( My::Class->meta()->get_method('bar')->foo(), 10,
+ '... call foo() on a wrapped method metaclass object' );
+}
+
+{
+ Moose::Util::MetaRole::apply_metaclass_roles(
for_class => 'My::Class',
instance_metaclass_roles => ['Role::Foo'],
);
{
ok( My::Class5->meta()->meta()->does_role('Role::Foo'),
- q{My::Class55->meta()'s does Role::Foo because it extends My::Class} );
+ q{My::Class5->meta()'s does Role::Foo because it extends My::Class} );
ok( My::Class5->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
q{My::Class5->meta()'s attribute metaclass also does Role::Foo} );
ok( My::Class5->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
ok( My::Class9->meta()->attribute_metaclass->meta()->does_role('Role::Foo'),
q{... and My::Class9->meta()->attribute_metaclass does Role::Foo because My::Class9 extends My::Class} );
}
+
+# This tests applying meta roles to a metaclass's metaclass. This is
+# completely insane, but is exactly what happens with
+# Fey::Meta::Class::Table. It's a subclass of Moose::Meta::Class
+# itself, and then it _uses_ MooseX::ClassAttribute, so the metaclass
+# for Fey::Meta::Class::Table does a role.
+#
+# At one point this caused a metaclass incompatibility error down
+# below, when we applied roles to the metaclass of My::Class10. It's
+# all madness but as long as the tests pass we're happy.
+{
+ package My::Meta::Class2;
+ use Moose;
+ extends 'Moose::Meta::Class';
+
+ Moose::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Meta::Class2',
+ metaclass_roles => ['Role::Foo'],
+ );
+}
+
+{
+ package My::Object;
+ use Moose;
+ extends 'Moose::Object';
+}
+
+{
+ package My::Meta2;
+
+ use Moose::Exporter;
+ Moose::Exporter->setup_import_methods( also => 'Moose' );
+
+ sub init_meta {
+ shift;
+ my %p = @_;
+
+ Moose->init_meta(
+ %p,
+ metaclass => 'My::Meta::Class2',
+ base_class => 'My::Object',
+ );
+ }
+}
+
+{
+ package My::Class10;
+ My::Meta2->import;
+
+ Moose::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Class10',
+ metaclass_roles => ['Role::Bar'],
+ );
+}
+
+{
+ ok( My::Class10->meta()->meta()->meta()->does_role('Role::Foo'),
+ q{My::Class10->meta()->meta() does Role::Foo } );
+ ok( My::Class10->meta()->meta()->does_role('Role::Bar'),
+ q{My::Class10->meta()->meta() does Role::Bar } );
+ ok( My::Class10->meta()->isa('My::Meta::Class2'),
+ q{... and My::Class10->meta still isa(My::Meta::Class2)} );
+ ok( My::Class10->isa('My::Object'),
+ q{... and My::Class10 still isa(My::Object)} );
+}
+
+{
+ package My::Constructor;
+
+ use base 'Moose::Meta::Method::Constructor';
+}
+
+{
+ package My::Class11;
+
+ use Moose;
+
+ __PACKAGE__->meta->constructor_class('My::Constructor');
+
+ Moose::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Class11',
+ metaclass_roles => ['Role::Foo'],
+ );
+}
+
+{
+ ok( My::Class11->meta()->meta()->does_role('Role::Foo'),
+ q{My::Class11->meta()->meta() does Role::Foo } );
+ is( My::Class11->meta()->constructor_class, 'My::Constructor',
+ q{... and explicitly set constructor_class value is unchanged)} );
+}
+
+{
+ package ExportsMoose;
+
+ Moose::Exporter->setup_import_methods(
+ also => 'Moose',
+ );
+
+ sub init_meta {
+ shift;
+ my %p = @_;
+ Moose->init_meta(%p);
+ return Moose::Util::MetaRole::apply_metaclass_roles(
+ for_class => $p{for_class},
+ # Causes us to recurse through init_meta, as we have to
+ # load MyMetaclassRole from disk.
+ metaclass_roles => [qw/MyMetaclassRole/],
+ );
+ }
+}
+
+lives_ok {
+ package UsesExportedMoose;
+ ExportsMoose->import;
+} 'import module which loads a role from disk during init_meta';
+
+{
+ package Foo::Meta::Role;
+
+ use Moose::Role;
+}
+{
+ package Foo::Role;
+
+ Moose::Exporter->setup_import_methods(
+ also => 'Moose::Role',
+ );
+
+ sub init_meta {
+ shift;
+ my %p = @_;
+ Moose::Role->init_meta(%p);
+ return Moose::Util::MetaRole::apply_metaclass_roles(
+ for_class => $p{for_class},
+ method_metaclass_roles => [ 'Foo::Meta::Role', ],
+ );
+ }
+}
+{
+ package Role::Baz;
+
+ Foo::Role->import;
+
+ sub bla {}
+}
+{
+ package My::Class12;
+
+ use Moose;
+
+ with( 'Role::Baz' );
+}
+{
+ ok(
+ My::Class12->meta->does_role( 'Role::Baz' ),
+ 'role applied'
+ );
+ my $method = My::Class12->meta->get_method( 'bla' );
+ ok(
+ $method->meta->does_role( 'Foo::Meta::Role' ),
+ 'method_metaclass_role applied'
+ );
+}
projects / gitmo/Moose.git / blobdiff