--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use lib 't/lib', 'lib';
+
+use Test::More tests => 91;
+use Test::Exception;
+
+use Mouse::Util::MetaRole;
+
+
+{
+ package My::Meta::Class;
+ use Mouse;
+ extends 'Mouse::Meta::Class';
+}
+
+{
+ package Role::Foo;
+ use Mouse::Role;
+ has 'foo' => ( is => 'ro', default => 10 );
+}
+
+{
+ package My::Class;
+
+ use Mouse;
+}
+
+{
+ package My::Role;
+ use Mouse::Role;
+}
+
+{
+ Mouse::Util::MetaRole::apply_metaclass_roles(
+ for_class => My::Class->meta,
+ metaclass_roles => ['Role::Foo'],
+ );
+
+ ok( My::Class->meta()->meta()->does_role('Role::Foo'),
+ 'apply Role::Foo to My::Class->meta()' );
+ is( My::Class->meta()->foo(), 10,
+ '... and call foo() on that meta object' );
+}
+
+{
+ Mouse::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Class',
+ attribute_metaclass_roles => ['Role::Foo'],
+ );
+
+ ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
+ q{apply Role::Foo to My::Class->meta()'s attribute metaclass} );
+ ok( My::Class->meta()->meta()->does_role('Role::Foo'),
+ '... My::Class->meta() still does Role::Foo' );
+
+ My::Class->meta()->add_attribute( 'size', is => 'ro' );
+ is( My::Class->meta()->get_attribute('size')->foo(), 10,
+ '... call foo() on an attribute metaclass object' );
+}
+
+{
+ Mouse::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Class',
+ method_metaclass_roles => ['Role::Foo'],
+ );
+
+ ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
+ q{apply Role::Foo to My::Class->meta()'s method metaclass} );
+ 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_method( 'bar' => sub { 'bar' } );
+ is( My::Class->meta()->get_method('bar')->foo(), 10,
+ '... call foo() on a method metaclass object' );
+}
+
+{
+ Mouse::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' );
+}
+
+{
+ Mouse::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Class',
+ instance_metaclass_roles => ['Role::Foo'],
+ );
+
+ ok( My::Class->meta()->instance_metaclass()->meta()->does_role('Role::Foo'),
+ q{apply Role::Foo to My::Class->meta()'s instance metaclass} );
+ 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} );
+ ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
+ q{... My::Class->meta()'s method metaclass still does Role::Foo} );
+
+ is( My::Class->meta()->get_meta_instance()->foo(), 10,
+ '... call foo() on an instance metaclass object' );
+}
+
+{
+ Mouse::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Class',
+ constructor_class_roles => ['Role::Foo'],
+ );
+
+ ok( My::Class->meta()->constructor_class()->meta()->does_role('Role::Foo'),
+ q{apply Role::Foo to My::Class->meta()'s constructor class} );
+ 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} );
+ ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
+ q{... My::Class->meta()'s method metaclass still does Role::Foo} );
+ ok( My::Class->meta()->instance_metaclass()->meta()->does_role('Role::Foo'),
+ q{... My::Class->meta()'s instance metaclass still does Role::Foo} );
+
+ # Actually instantiating the constructor class is too freaking hard!
+ ok( My::Class->meta()->constructor_class()->can('foo'),
+ '... constructor class has a foo method' );
+}
+
+{
+ Mouse::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Class',
+ destructor_class_roles => ['Role::Foo'],
+ );
+
+ ok( My::Class->meta()->destructor_class()->meta()->does_role('Role::Foo'),
+ q{apply Role::Foo to My::Class->meta()'s destructor class} );
+ 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} );
+ ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
+ q{... My::Class->meta()'s method metaclass still does Role::Foo} );
+ ok( My::Class->meta()->instance_metaclass()->meta()->does_role('Role::Foo'),
+ q{... My::Class->meta()'s instance metaclass still does Role::Foo} );
+ ok( My::Class->meta()->constructor_class()->meta()->does_role('Role::Foo'),
+ q{... My::Class->meta()'s constructor class still does Role::Foo} );
+
+ # same problem as the constructor class
+ ok( My::Class->meta()->destructor_class()->can('foo'),
+ '... destructor class has a foo method' );
+}
+
+{
+ Mouse::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Role',
+ application_to_class_class_roles => ['Role::Foo'],
+ );
+
+ ok( My::Role->meta->application_to_class_class->meta->does_role('Role::Foo'),
+ q{apply Role::Foo to My::Role->meta's application_to_class class} );
+
+ is( My::Role->meta->application_to_class_class->new->foo, 10,
+ q{... call foo() on an application_to_class instance} );
+}
+
+{
+ Mouse::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Role',
+ application_to_role_class_roles => ['Role::Foo'],
+ );
+
+ ok( My::Role->meta->application_to_role_class->meta->does_role('Role::Foo'),
+ q{apply Role::Foo to My::Role->meta's application_to_role class} );
+ ok( My::Role->meta->application_to_class_class->meta->does_role('Role::Foo'),
+ q{... My::Role->meta's application_to_class class still does Role::Foo} );
+
+ is( My::Role->meta->application_to_role_class->new->foo, 10,
+ q{... call foo() on an application_to_role instance} );
+}
+
+{
+ Mouse::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Role',
+ application_to_instance_class_roles => ['Role::Foo'],
+ );
+
+ ok( My::Role->meta->application_to_instance_class->meta->does_role('Role::Foo'),
+ q{apply Role::Foo to My::Role->meta's application_to_instance class} );
+ ok( My::Role->meta->application_to_role_class->meta->does_role('Role::Foo'),
+ q{... My::Role->meta's application_to_role class still does Role::Foo} );
+ ok( My::Role->meta->application_to_class_class->meta->does_role('Role::Foo'),
+ q{... My::Role->meta's application_to_class class still does Role::Foo} );
+
+ is( My::Role->meta->application_to_instance_class->new->foo, 10,
+ q{... call foo() on an application_to_instance instance} );
+}
+
+{
+ Mouse::Util::MetaRole::apply_base_class_roles(
+ for_class => 'My::Class',
+ roles => ['Role::Foo'],
+ );
+
+ ok( My::Class->meta()->does_role('Role::Foo'),
+ 'apply Role::Foo to My::Class base class' );
+ is( My::Class->new()->foo(), 10,
+ '... call foo() on a My::Class object' );
+}
+
+{
+ package My::Class2;
+
+ use Mouse;
+}
+
+{
+ Mouse::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Class2',
+ metaclass_roles => ['Role::Foo'],
+ attribute_metaclass_roles => ['Role::Foo'],
+ method_metaclass_roles => ['Role::Foo'],
+ instance_metaclass_roles => ['Role::Foo'],
+ constructor_class_roles => ['Role::Foo'],
+ destructor_class_roles => ['Role::Foo'],
+ );
+
+ ok( My::Class2->meta()->meta()->does_role('Role::Foo'),
+ 'apply Role::Foo to My::Class2->meta()' );
+ is( My::Class2->meta()->foo(), 10,
+ '... and call foo() on that meta object' );
+ ok( My::Class2->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
+ q{apply Role::Foo to My::Class2->meta()'s attribute metaclass} );
+ My::Class2->meta()->add_attribute( 'size', is => 'ro' );
+
+ is( My::Class2->meta()->get_attribute('size')->foo(), 10,
+ '... call foo() on an attribute metaclass object' );
+
+ ok( My::Class2->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
+ q{apply Role::Foo to My::Class2->meta()'s method metaclass} );
+
+ My::Class2->meta()->add_method( 'bar' => sub { 'bar' } );
+ is( My::Class2->meta()->get_method('bar')->foo(), 10,
+ '... call foo() on a method metaclass object' );
+
+ ok( My::Class2->meta()->instance_metaclass()->meta()->does_role('Role::Foo'),
+ q{apply Role::Foo to My::Class2->meta()'s instance metaclass} );
+ is( My::Class2->meta()->get_meta_instance()->foo(), 10,
+ '... call foo() on an instance metaclass object' );
+
+ ok( My::Class2->meta()->constructor_class()->meta()->does_role('Role::Foo'),
+ q{apply Role::Foo to My::Class2->meta()'s constructor class} );
+ ok( My::Class2->meta()->constructor_class()->can('foo'),
+ '... constructor class has a foo method' );
+
+ ok( My::Class2->meta()->destructor_class()->meta()->does_role('Role::Foo'),
+ q{apply Role::Foo to My::Class2->meta()'s destructor class} );
+ ok( My::Class2->meta()->destructor_class()->can('foo'),
+ '... destructor class has a foo method' );
+}
+
+
+{
+ package My::Meta;
+
+ use Mouse::Exporter;
+ Mouse::Exporter->setup_import_methods( also => 'Mouse' );
+
+ sub init_meta {
+ shift;
+ my %p = @_;
+
+ Mouse->init_meta( %p, metaclass => 'My::Meta::Class' );
+ }
+}
+
+{
+ package My::Class3;
+
+ My::Meta->import();
+}
+
+
+{
+ Mouse::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Class3',
+ metaclass_roles => ['Role::Foo'],
+ );
+
+ ok( My::Class3->meta()->meta()->does_role('Role::Foo'),
+ 'apply Role::Foo to My::Class3->meta()' );
+ is( My::Class3->meta()->foo(), 10,
+ '... and call foo() on that meta object' );
+ ok( ( grep { $_ eq 'My::Meta::Class' } My::Class3->meta()->meta()->superclasses() ),
+ 'apply_metaclass_roles() does not interfere with metaclass set via Mouse->init_meta()' );
+}
+
+{
+ package Role::Bar;
+ use Mouse::Role;
+ has 'bar' => ( is => 'ro', default => 200 );
+}
+
+{
+ package My::Class4;
+ use Mouse;
+}
+
+{
+ Mouse::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Class4',
+ metaclass_roles => ['Role::Foo'],
+ );
+
+ ok( My::Class4->meta()->meta()->does_role('Role::Foo'),
+ 'apply Role::Foo to My::Class4->meta()' );
+
+ Mouse::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Class4',
+ metaclass_roles => ['Role::Bar'],
+ );
+
+ ok( My::Class4->meta()->meta()->does_role('Role::Bar'),
+ 'apply Role::Bar to My::Class4->meta()' );
+ ok( My::Class4->meta()->meta()->does_role('Role::Foo'),
+ '... and My::Class4->meta() still does Role::Foo' );
+}
+
+{
+ package My::Class5;
+ use Mouse;
+
+ extends 'My::Class';
+}
+
+{
+ ok( My::Class5->meta()->meta()->does_role('Role::Foo'),
+ 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'),
+ q{My::Class5->meta()'s method metaclass also does Role::Foo} );
+ ok( My::Class5->meta()->instance_metaclass()->meta()->does_role('Role::Foo'),
+ q{My::Class5->meta()'s instance metaclass also does Role::Foo} );
+ ok( My::Class5->meta()->constructor_class()->meta()->does_role('Role::Foo'),
+ q{My::Class5->meta()'s constructor class also does Role::Foo} );
+ ok( My::Class5->meta()->destructor_class()->meta()->does_role('Role::Foo'),
+ q{My::Class5->meta()'s destructor class also does Role::Foo} );
+}
+
+{
+ Mouse::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Class5',
+ metaclass_roles => ['Role::Bar'],
+ );
+
+ ok( My::Class5->meta()->meta()->does_role('Role::Bar'),
+ q{apply Role::Bar My::Class5->meta()} );
+ ok( My::Class5->meta()->meta()->does_role('Role::Foo'),
+ q{... and My::Class5->meta() still does Role::Foo} );
+}
+
+{
+ package My::Class6;
+ use Mouse;
+
+ Mouse::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Class6',
+ metaclass_roles => ['Role::Bar'],
+ );
+
+ extends 'My::Class';
+}
+
+{
+ ok( My::Class6->meta()->meta()->does_role('Role::Bar'),
+ q{apply Role::Bar My::Class6->meta() before extends} );
+ ok( My::Class6->meta()->meta()->does_role('Role::Foo'),
+ q{... and My::Class6->meta() does Role::Foo because My::Class6 extends My::Class} );
+}
+
+# This is the hack that used to be needed to work around the
+# _fix_metaclass_incompatibility problem. You called extends() (which
+# in turn calls _fix_metaclass_imcompatibility) _before_ you apply
+# more extensions in the subclass. We wabt to make sure this continues
+# to work in the future.
+{
+ package My::Class7;
+ use Mouse;
+
+ # In real usage this would go in a BEGIN block so it happened
+ # before apply_metaclass_roles was called by an extension.
+ extends 'My::Class';
+
+ Mouse::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Class7',
+ metaclass_roles => ['Role::Bar'],
+ );
+}
+
+{
+ ok( My::Class7->meta()->meta()->does_role('Role::Bar'),
+ q{apply Role::Bar My::Class7->meta() before extends} );
+ ok( My::Class7->meta()->meta()->does_role('Role::Foo'),
+ q{... and My::Class7->meta() does Role::Foo because My::Class7 extends My::Class} );
+}
+
+{
+ package My::Class8;
+ use Mouse;
+
+ Mouse::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Class8',
+ metaclass_roles => ['Role::Bar'],
+ attribute_metaclass_roles => ['Role::Bar'],
+ );
+
+ extends 'My::Class';
+}
+
+{
+ ok( My::Class8->meta()->meta()->does_role('Role::Bar'),
+ q{apply Role::Bar My::Class8->meta() before extends} );
+ ok( My::Class8->meta()->meta()->does_role('Role::Foo'),
+ q{... and My::Class8->meta() does Role::Foo because My::Class8 extends My::Class} );
+ ok( My::Class8->meta()->attribute_metaclass->meta()->does_role('Role::Bar'),
+ q{apply Role::Bar to My::Class8->meta()->attribute_metaclass before extends} );
+ ok( My::Class8->meta()->attribute_metaclass->meta()->does_role('Role::Foo'),
+ q{... and My::Class8->meta()->attribute_metaclass does Role::Foo because My::Class8 extends My::Class} );
+}
+
+
+{
+ package My::Class9;
+ use Mouse;
+
+ Mouse::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Class9',
+ attribute_metaclass_roles => ['Role::Bar'],
+ );
+
+ extends 'My::Class';
+}
+
+{
+ ok( My::Class9->meta()->meta()->does_role('Role::Foo'),
+ q{... and My::Class9->meta() does Role::Foo because My::Class9 extends My::Class} );
+ ok( My::Class9->meta()->attribute_metaclass->meta()->does_role('Role::Bar'),
+ q{apply Role::Bar to My::Class9->meta()->attribute_metaclass before extends} );
+ 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 Mouse::Meta::Class
+# itself, and then it _uses_ MouseX::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 Mouse;
+ extends 'Mouse::Meta::Class';
+
+ Mouse::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Meta::Class2',
+ metaclass_roles => ['Role::Foo'],
+ );
+}
+
+{
+ package My::Object;
+ use Mouse;
+ extends 'Mouse::Object';
+}
+
+{
+ package My::Meta2;
+
+ use Mouse::Exporter;
+ Mouse::Exporter->setup_import_methods( also => 'Mouse' );
+
+ sub init_meta {
+ shift;
+ my %p = @_;
+
+ Mouse->init_meta(
+ %p,
+ metaclass => 'My::Meta::Class2',
+ base_class => 'My::Object',
+ );
+ }
+}
+
+{
+ package My::Class10;
+ My::Meta2->import;
+
+ Mouse::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 'Mouse::Meta::Method::Constructor';
+}
+
+{
+ package My::Class11;
+
+ use Mouse;
+
+ __PACKAGE__->meta->constructor_class('My::Constructor');
+
+ Mouse::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 ExportsMouse;
+
+ Mouse::Exporter->setup_import_methods(
+ also => 'Mouse',
+ );
+
+ sub init_meta {
+ shift;
+ my %p = @_;
+ Mouse->init_meta(%p);
+ return Mouse::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 UsesExportedMouse;
+ ExportsMouse->import;
+} 'import module which loads a role from disk during init_meta';
+
+{
+ package Foo::Meta::Role;
+
+ use Mouse::Role;
+}
+{
+ package Foo::Role;
+
+ Mouse::Exporter->setup_import_methods(
+ also => 'Mouse::Role',
+ );
+
+ sub init_meta {
+ shift;
+ my %p = @_;
+ Mouse::Role->init_meta(%p);
+ return Mouse::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 Mouse;
+
+ 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'
+ );
+}
+
+{
+ package Parent;
+ use Mouse;
+
+ Mouse::Util::MetaRole::apply_metaclass_roles(
+ for_class => __PACKAGE__,
+ constructor_class_roles => ['Role::Foo'],
+ );
+}
+
+{
+ package Child;
+
+ use Mouse;
+ extends 'Parent';
+}
+
+{
+ ok(
+ Parent->meta->constructor_class->meta->can('does_role')
+ && Parent->meta->constructor_class->meta->does_role('Role::Foo'),
+ 'Parent constructor class has metarole from Parent'
+ );
+
+TODO:
+ {
+ local $TODO
+ = 'Mouse does not see that the child differs from the parent because it only checks the class and instance metaclasses do determine compatibility';
+ ok(
+ Child->meta->constructor_class->meta->can('does_role')
+ && Child->meta->constructor_class->meta->does_role(
+ 'Role::Foo'),
+ 'Child constructor class has metarole from Parent'
+ );
+ }
+}
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 4;
+use Test::Exception;
+
+
+
+=pod
+
+This test demonstrates that Mouse will respect
+a metaclass previously set with the metaclass
+pragma.
+
+It also checks an error condition where that
+metaclass must be a Mouse::Meta::Class subclass
+in order to work.
+
+=cut
+
+
+{
+ package Foo::Meta;
+ use strict;
+ use warnings;
+
+ use base 'Mouse::Meta::Class';
+
+ package Foo;
+ use strict;
+ use warnings;
+ use metaclass 'Foo::Meta';
+ ::use_ok('Mouse');
+}
+
+isa_ok(Foo->meta, 'Foo::Meta');
+
+{
+ package Bar::Meta;
+ use strict;
+ use warnings;
+
+ use base 'Class::MOP::Class';
+
+ package Bar;
+ use strict;
+ use warnings;
+ use metaclass 'Bar::Meta';
+ eval 'use Mouse;';
+ ::ok($@, '... could not load moose without correct metaclass');
+ ::like($@,
+ qr/^Bar already has a metaclass, but it does not inherit Mouse::Meta::Class/,
+ '... got the right error too');
+}
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 16;
+use Test::Exception;
+
+
+
+=pod
+
+This test demonstrates the ability to extend
+Mouse meta-level classes using Mouse itself.
+
+=cut
+
+{
+ package My::Meta::Class;
+ use Mouse;
+
+ extends 'Mouse::Meta::Class';
+
+ around 'create_anon_class' => sub {
+ my $next = shift;
+ my ($self, %options) = @_;
+ $options{superclasses} = [ 'Mouse::Object' ]
+ unless exists $options{superclasses};
+ $next->($self, %options);
+ };
+}
+
+my $anon = My::Meta::Class->create_anon_class();
+isa_ok($anon, 'My::Meta::Class');
+isa_ok($anon, 'Mouse::Meta::Class');
+isa_ok($anon, 'Class::MOP::Class');
+
+is_deeply(
+ [ $anon->superclasses ],
+ [ 'Mouse::Object' ],
+ '... got the default superclasses');
+
+{
+ package My::Meta::Attribute::DefaultReadOnly;
+ use Mouse;
+
+ extends 'Mouse::Meta::Attribute';
+
+ around 'new' => sub {
+ my $next = shift;
+ my ($self, $name, %options) = @_;
+ $options{is} = 'ro'
+ unless exists $options{is};
+ $next->($self, $name, %options);
+ };
+}
+
+{
+ my $attr = My::Meta::Attribute::DefaultReadOnly->new('foo');
+ isa_ok($attr, 'My::Meta::Attribute::DefaultReadOnly');
+ isa_ok($attr, 'Mouse::Meta::Attribute');
+ isa_ok($attr, 'Class::MOP::Attribute');
+
+ ok($attr->has_reader, '... the attribute has a reader (as expected)');
+ ok(!$attr->has_writer, '... the attribute does not have a writer (as expected)');
+ ok(!$attr->has_accessor, '... the attribute does not have an accessor (as expected)');
+}
+
+{
+ my $attr = My::Meta::Attribute::DefaultReadOnly->new('foo', (is => 'rw'));
+ isa_ok($attr, 'My::Meta::Attribute::DefaultReadOnly');
+ isa_ok($attr, 'Mouse::Meta::Attribute');
+ isa_ok($attr, 'Class::MOP::Attribute');
+
+ ok(!$attr->has_reader, '... the attribute does not have a reader (as expected)');
+ ok(!$attr->has_writer, '... the attribute does not have a writer (as expected)');
+ ok($attr->has_accessor, '... the attribute does have an accessor (as expected)');
+}
+
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 7;
+use Test::Exception;
+
+
+
+BEGIN {
+ package MyFramework::Base;
+ use Mouse;
+
+ package MyFramework::Meta::Base;
+ use Mouse;
+
+ extends 'Mouse::Meta::Class';
+
+ package MyFramework;
+ use Mouse;
+
+ sub import {
+ my $CALLER = caller();
+
+ strict->import;
+ warnings->import;
+
+ return if $CALLER eq 'main';
+ Mouse::init_meta( $CALLER, 'MyFramework::Base', 'MyFramework::Meta::Base' );
+ Mouse->import({ into => $CALLER });
+
+ return 1;
+ }
+}
+
+{
+ package MyClass;
+ BEGIN { MyFramework->import }
+
+ has 'foo' => (is => 'rw');
+}
+
+can_ok( 'MyClass', 'meta' );
+
+isa_ok(MyClass->meta, 'MyFramework::Meta::Base');
+isa_ok(MyClass->meta, 'Mouse::Meta::Class');
+
+my $obj = MyClass->new(foo => 10);
+isa_ok($obj, 'MyClass');
+isa_ok($obj, 'MyFramework::Base');
+isa_ok($obj, 'Mouse::Object');
+
+is($obj->foo, 10, '... got the right value');
+
+
+
+
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+BEGIN {
+ eval "use Test::Output;";
+ plan skip_all => "Test::Output is required for this test" if $@;
+ plan tests => 65;
+}
+
+
+{
+ package HasOwnImmutable;
+
+ use Mouse;
+
+ no Mouse;
+
+ ::stderr_is( sub { eval q[sub make_immutable { return 'foo' }] },
+ '',
+ 'no warning when defining our own make_immutable sub' );
+}
+
+{
+ is( HasOwnImmutable->make_immutable(), 'foo',
+ 'HasOwnImmutable->make_immutable does not get overwritten' );
+}
+
+{
+ package MouseX::Empty;
+
+ use Mouse ();
+ Mouse::Exporter->setup_import_methods( also => 'Mouse' );
+}
+
+{
+ package WantsMouse;
+
+ MouseX::Empty->import();
+
+ sub foo { 1 }
+
+ ::can_ok( 'WantsMouse', 'has' );
+ ::can_ok( 'WantsMouse', 'with' );
+ ::can_ok( 'WantsMouse', 'foo' );
+
+ MouseX::Empty->unimport();
+}
+
+{
+ # Note: it's important that these methods be out of scope _now_,
+ # after unimport was called. We tried a
+ # namespace::clean(0.08)-based solution, but had to abandon it
+ # because it cleans the namespace _later_ (when the file scope
+ # ends).
+ ok( ! WantsMouse->can('has'), 'WantsMouse::has() has been cleaned' );
+ ok( ! WantsMouse->can('with'), 'WantsMouse::with() has been cleaned' );
+ can_ok( 'WantsMouse', 'foo' );
+
+ # This makes sure that Mouse->init_meta() happens properly
+ isa_ok( WantsMouse->meta(), 'Mouse::Meta::Class' );
+ isa_ok( WantsMouse->new(), 'Mouse::Object' );
+
+}
+
+{
+ package MouseX::Sugar;
+
+ use Mouse ();
+
+ sub wrapped1 {
+ my $meta = shift;
+ return $meta->name . ' called wrapped1';
+ }
+
+ Mouse::Exporter->setup_import_methods(
+ with_meta => ['wrapped1'],
+ also => 'Mouse',
+ );
+}
+
+{
+ package WantsSugar;
+
+ MouseX::Sugar->import();
+
+ sub foo { 1 }
+
+ ::can_ok( 'WantsSugar', 'has' );
+ ::can_ok( 'WantsSugar', 'with' );
+ ::can_ok( 'WantsSugar', 'wrapped1' );
+ ::can_ok( 'WantsSugar', 'foo' );
+ ::is( wrapped1(), 'WantsSugar called wrapped1',
+ 'wrapped1 identifies the caller correctly' );
+
+ MouseX::Sugar->unimport();
+}
+
+{
+ ok( ! WantsSugar->can('has'), 'WantsSugar::has() has been cleaned' );
+ ok( ! WantsSugar->can('with'), 'WantsSugar::with() has been cleaned' );
+ ok( ! WantsSugar->can('wrapped1'), 'WantsSugar::wrapped1() has been cleaned' );
+ can_ok( 'WantsSugar', 'foo' );
+}
+
+{
+ package MouseX::MoreSugar;
+
+ use Mouse ();
+
+ sub wrapped2 {
+ my $caller = shift;
+ return $caller . ' called wrapped2';
+ }
+
+ sub as_is1 {
+ return 'as_is1';
+ }
+
+ Mouse::Exporter->setup_import_methods(
+ with_caller => ['wrapped2'],
+ as_is => ['as_is1'],
+ also => 'MouseX::Sugar',
+ );
+}
+
+{
+ package WantsMoreSugar;
+
+ MouseX::MoreSugar->import();
+
+ sub foo { 1 }
+
+ ::can_ok( 'WantsMoreSugar', 'has' );
+ ::can_ok( 'WantsMoreSugar', 'with' );
+ ::can_ok( 'WantsMoreSugar', 'wrapped1' );
+ ::can_ok( 'WantsMoreSugar', 'wrapped2' );
+ ::can_ok( 'WantsMoreSugar', 'as_is1' );
+ ::can_ok( 'WantsMoreSugar', 'foo' );
+ ::is( wrapped1(), 'WantsMoreSugar called wrapped1',
+ 'wrapped1 identifies the caller correctly' );
+ ::is( wrapped2(), 'WantsMoreSugar called wrapped2',
+ 'wrapped2 identifies the caller correctly' );
+ ::is( as_is1(), 'as_is1',
+ 'as_is1 works as expected' );
+
+ MouseX::MoreSugar->unimport();
+}
+
+{
+ ok( ! WantsMoreSugar->can('has'), 'WantsMoreSugar::has() has been cleaned' );
+ ok( ! WantsMoreSugar->can('with'), 'WantsMoreSugar::with() has been cleaned' );
+ ok( ! WantsMoreSugar->can('wrapped1'), 'WantsMoreSugar::wrapped1() has been cleaned' );
+ ok( ! WantsMoreSugar->can('wrapped2'), 'WantsMoreSugar::wrapped2() has been cleaned' );
+ ok( ! WantsMoreSugar->can('as_is1'), 'WantsMoreSugar::as_is1() has been cleaned' );
+ can_ok( 'WantsMoreSugar', 'foo' );
+}
+
+{
+ package My::Metaclass;
+ use Mouse;
+ BEGIN { extends 'Mouse::Meta::Class' }
+
+ package My::Object;
+ use Mouse;
+ BEGIN { extends 'Mouse::Object' }
+
+ package HasInitMeta;
+
+ use Mouse ();
+
+ sub init_meta {
+ shift;
+ return Mouse->init_meta( @_,
+ metaclass => 'My::Metaclass',
+ base_class => 'My::Object',
+ );
+ }
+
+ Mouse::Exporter->setup_import_methods( also => 'Mouse' );
+}
+
+{
+ package NewMeta;
+
+ HasInitMeta->import();
+}
+
+{
+ isa_ok( NewMeta->meta(), 'My::Metaclass' );
+ isa_ok( NewMeta->new(), 'My::Object' );
+}
+
+{
+ package MouseX::CircularAlso;
+
+ use Mouse ();
+
+ ::dies_ok(
+ sub {
+ Mouse::Exporter->setup_import_methods(
+ also => [ 'Mouse', 'MouseX::CircularAlso' ],
+ );
+ },
+ 'a circular reference in also dies with an error'
+ );
+
+ ::like(
+ $@,
+ qr/\QCircular reference in 'also' parameter to Mouse::Exporter between MouseX::CircularAlso and MouseX::CircularAlso/,
+ 'got the expected error from circular reference in also'
+ );
+}
+
+{
+ package MouseX::NoAlso;
+
+ use Mouse ();
+
+ ::dies_ok(
+ sub {
+ Mouse::Exporter->setup_import_methods(
+ also => [ 'NoSuchThing' ],
+ );
+ },
+ 'a package which does not use Mouse::Exporter in also dies with an error'
+ );
+
+ ::like(
+ $@,
+ qr/\QPackage in also (NoSuchThing) does not seem to use Mouse::Exporter (is it loaded?) at /,
+ 'got the expected error from a reference in also to a package which is not loaded'
+ );
+}
+
+{
+ package MouseX::NotExporter;
+
+ use Mouse ();
+
+ ::dies_ok(
+ sub {
+ Mouse::Exporter->setup_import_methods(
+ also => [ 'Mouse::Meta::Method' ],
+ );
+ },
+ 'a package which does not use Mouse::Exporter in also dies with an error'
+ );
+
+ ::like(
+ $@,
+ qr/\QPackage in also (Mouse::Meta::Method) does not seem to use Mouse::Exporter at /,
+ 'got the expected error from a reference in also to a package which does not use Mouse::Exporter'
+ );
+}
+
+{
+ package MouseX::OverridingSugar;
+
+ use Mouse ();
+
+ sub has {
+ my $caller = shift;
+ return $caller . ' called has';
+ }
+
+ Mouse::Exporter->setup_import_methods(
+ with_caller => ['has'],
+ also => 'Mouse',
+ );
+}
+
+{
+ package WantsOverridingSugar;
+
+ MouseX::OverridingSugar->import();
+
+ ::can_ok( 'WantsOverridingSugar', 'has' );
+ ::can_ok( 'WantsOverridingSugar', 'with' );
+ ::is( has('foo'), 'WantsOverridingSugar called has',
+ 'has from MouseX::OverridingSugar is called, not has from Mouse' );
+
+ MouseX::OverridingSugar->unimport();
+}
+
+{
+ ok( ! WantsSugar->can('has'), 'WantsSugar::has() has been cleaned' );
+ ok( ! WantsSugar->can('with'), 'WantsSugar::with() has been cleaned' );
+}
+
+{
+ package NonExistentExport;
+
+ use Mouse ();
+
+ ::stderr_like {
+ Mouse::Exporter->setup_import_methods(
+ also => ['Mouse'],
+ with_caller => ['does_not_exist'],
+ );
+ } qr/^Trying to export undefined sub NonExistentExport::does_not_exist/,
+ "warns when a non-existent method is requested to be exported";
+}
+
+{
+ package WantsNonExistentExport;
+
+ NonExistentExport->import;
+
+ ::ok(!__PACKAGE__->can('does_not_exist'),
+ "undefined subs do not get exported");
+}
+
+{
+ package AllOptions;
+ use Mouse ();
+ use Mouse::Exporter;
+
+ Mouse::Exporter->setup_import_methods(
+ also => ['Mouse'],
+ with_meta => [ 'with_meta1', 'with_meta2' ],
+ with_caller => [ 'with_caller1', 'with_caller2' ],
+ as_is => ['as_is1'],
+ );
+
+ sub with_caller1 {
+ return @_;
+ }
+
+ sub with_caller2 (&) {
+ return @_;
+ }
+
+ sub as_is1 {2}
+
+ sub with_meta1 {
+ return @_;
+ }
+
+ sub with_meta2 (&) {
+ return @_;
+ }
+}
+
+{
+ package UseAllOptions;
+
+ AllOptions->import();
+}
+
+{
+ can_ok( 'UseAllOptions', $_ )
+ for qw( with_meta1 with_meta2 with_caller1 with_caller2 as_is1 );
+
+ {
+ my ( $caller, $arg1 ) = UseAllOptions::with_caller1(42);
+ is( $caller, 'UseAllOptions', 'with_caller wrapped sub gets the right caller' );
+ is( $arg1, 42, 'with_caller wrapped sub returns argument it was passed' );
+ }
+
+ {
+ my ( $meta, $arg1 ) = UseAllOptions::with_meta1(42);
+ isa_ok( $meta, 'Mouse::Meta::Class', 'with_meta first argument' );
+ is( $arg1, 42, 'with_meta1 returns argument it was passed' );
+ }
+
+ is(
+ prototype( UseAllOptions->can('with_caller2') ),
+ prototype( AllOptions->can('with_caller2') ),
+ 'using correct prototype on with_meta function'
+ );
+
+ is(
+ prototype( UseAllOptions->can('with_meta2') ),
+ prototype( AllOptions->can('with_meta2') ),
+ 'using correct prototype on with_meta function'
+ );
+}
+
+{
+ package UseAllOptions;
+ AllOptions->unimport();
+}
+
+{
+ ok( ! UseAllOptions->can($_), "UseAllOptions::$_ has been unimported" )
+ for qw( with_meta1 with_meta2 with_caller1 with_caller2 as_is1 );
+}
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use lib 't/lib', 'lib';
+
+use Test::More tests => 32;
+use Test::Exception;
+
+{
+ package My::SimpleTrait;
+
+ use Mouse::Role;
+
+ sub simple { return 5 }
+}
+
+{
+ package Foo;
+
+ use Mouse -traits => [ 'My::SimpleTrait' ];
+}
+
+can_ok( Foo->meta(), 'simple' );
+is( Foo->meta()->simple(), 5,
+ 'Foo->meta()->simple() returns expected value' );
+
+{
+ package Bar;
+
+ use Mouse -traits => 'My::SimpleTrait';
+}
+
+can_ok( Bar->meta(), 'simple' );
+is( Bar->meta()->simple(), 5,
+ 'Foo->meta()->simple() returns expected value' );
+
+{
+ package My::SimpleTrait2;
+
+ use Mouse::Role;
+
+ # This needs to happen at compile time so it happens before we
+ # apply traits to Bar
+ BEGIN {
+ has 'attr' =>
+ ( is => 'ro',
+ default => 'something',
+ );
+ }
+
+ sub simple { return 5 }
+}
+
+{
+ package Bar;
+
+ use Mouse -traits => [ 'My::SimpleTrait2' ];
+}
+
+can_ok( Bar->meta(), 'simple' );
+is( Bar->meta()->simple(), 5,
+ 'Bar->meta()->simple() returns expected value' );
+can_ok( Bar->meta(), 'attr' );
+is( Bar->meta()->attr(), 'something',
+ 'Bar->meta()->attr() returns expected value' );
+
+{
+ package My::SimpleTrait3;
+
+ use Mouse::Role;
+
+ BEGIN {
+ has 'attr2' =>
+ ( is => 'ro',
+ default => 'something',
+ );
+ }
+
+ sub simple2 { return 55 }
+}
+
+{
+ package Baz;
+
+ use Mouse -traits => [ 'My::SimpleTrait2', 'My::SimpleTrait3' ];
+}
+
+can_ok( Baz->meta(), 'simple' );
+is( Baz->meta()->simple(), 5,
+ 'Baz->meta()->simple() returns expected value' );
+can_ok( Baz->meta(), 'attr' );
+is( Baz->meta()->attr(), 'something',
+ 'Baz->meta()->attr() returns expected value' );
+can_ok( Baz->meta(), 'simple2' );
+is( Baz->meta()->simple2(), 55,
+ 'Baz->meta()->simple2() returns expected value' );
+can_ok( Baz->meta(), 'attr2' );
+is( Baz->meta()->attr2(), 'something',
+ 'Baz->meta()->attr2() returns expected value' );
+
+{
+ package My::Trait::AlwaysRO;
+
+ use Mouse::Role;
+
+ around '_process_new_attribute', '_process_inherited_attribute' =>
+ sub {
+ my $orig = shift;
+ my ( $self, $name, %args ) = @_;
+
+ $args{is} = 'ro';
+
+ return $self->$orig( $name, %args );
+ };
+}
+
+{
+ package Quux;
+
+ use Mouse -traits => [ 'My::Trait::AlwaysRO' ];
+
+ has 'size' =>
+ ( is => 'rw',
+ isa => 'Int',
+ );
+}
+
+ok( Quux->meta()->has_attribute('size'),
+ 'Quux has size attribute' );
+ok( ! Quux->meta()->get_attribute('size')->writer(),
+ 'size attribute does not have a writer' );
+
+{
+ package My::Class::Whatever;
+
+ use Mouse::Role;
+
+ sub whatever { 42 }
+
+ package Mouse::Meta::Class::Custom::Trait::Whatever;
+
+ sub register_implementation {
+ return 'My::Class::Whatever';
+ }
+}
+
+{
+ package RanOutOfNames;
+
+ use Mouse -traits => [ 'Whatever' ];
+}
+
+ok( RanOutOfNames->meta()->meta()->has_method('whatever'),
+ 'RanOutOfNames->meta() has whatever method' );
+
+{
+ package Role::Foo;
+
+ use Mouse::Role -traits => [ 'My::SimpleTrait' ];
+}
+
+can_ok( Role::Foo->meta(), 'simple' );
+is( Role::Foo->meta()->simple(), 5,
+ 'Role::Foo->meta()->simple() returns expected value' );
+
+{
+ require Mouse::Util::TypeConstraints;
+ dies_ok( sub { Mouse::Util::TypeConstraints->import( -traits => 'My::SimpleTrait' ) },
+ 'cannot provide -traits to an exporting module that does not init_meta' );
+ like( $@, qr/does not have an init_meta/,
+ '... and error provides a useful explanation' );
+}
+
+{
+ package Foo::Subclass;
+
+ use Mouse -traits => [ 'My::SimpleTrait3' ];
+
+ extends 'Foo';
+}
+
+can_ok( Foo::Subclass->meta(), 'simple' );
+is( Foo::Subclass->meta()->simple(), 5,
+ 'Foo::Subclass->meta()->simple() returns expected value' );
+is( Foo::Subclass->meta()->simple2(), 55,
+ 'Foo::Subclass->meta()->simple2() returns expected value' );
+can_ok( Foo::Subclass->meta(), 'attr2' );
+is( Foo::Subclass->meta()->attr2(), 'something',
+ 'Foo::Subclass->meta()->attr2() returns expected value' );
+
+{
+
+ package Class::WithAlreadyPresentTrait;
+ use Mouse -traits => 'My::SimpleTrait';
+
+ has an_attr => ( is => 'ro' );
+}
+
+lives_ok {
+ my $instance = Class::WithAlreadyPresentTrait->new( an_attr => 'value' );
+ is( $instance->an_attr, 'value', 'Can get value' );
+}
+'Can create instance and access attributes';
+
+{
+
+ package Class::WhichLoadsATraitFromDisk;
+
+ # Any role you like here, the only important bit is that it gets
+ # loaded from disk and has not already been defined.
+ use Mouse -traits => 'Role::Parent';
+
+ has an_attr => ( is => 'ro' );
+}
+
+lives_ok {
+ my $instance = Class::WhichLoadsATraitFromDisk->new( an_attr => 'value' );
+ is( $instance->an_attr, 'value', 'Can get value' );
+}
+'Can create instance and access attributes';
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 8;
+use Test::Exception;
+
+# Some packages out in the wild cooperate with Mouse by using goto
+# &Mouse::import. we want to make sure it still works.
+
+{
+ package MouseAlike1;
+
+ use strict;
+ use warnings;
+
+ use Mouse ();
+
+ sub import {
+ goto &Mouse::import;
+ }
+
+ sub unimport {
+ goto &Mouse::unimport;
+ }
+}
+
+{
+ package Foo;
+
+ MouseAlike1->import();
+
+ ::lives_ok( sub { has( 'size', is => 'bare' ) },
+ 'has was exported via MouseAlike1' );
+
+ MouseAlike1->unimport();
+}
+
+ok( ! Foo->can('has'),
+ 'No has sub in Foo after MouseAlike1 is unimported' );
+ok( Foo->can('meta'),
+ 'Foo has a meta method' );
+isa_ok( Foo->meta(), 'Mouse::Meta::Class' );
+
+
+{
+ package MouseAlike2;
+
+ use strict;
+ use warnings;
+
+ use Mouse ();
+
+ my $import = \&Mouse::import;
+ sub import {
+ goto $import;
+ }
+
+ my $unimport = \&Mouse::unimport;
+ sub unimport {
+ goto $unimport;
+ }
+}
+
+{
+ package Bar;
+
+ MouseAlike2->import();
+
+ ::lives_ok( sub { has( 'size', is => 'bare' ) },
+ 'has was exported via MouseAlike2' );
+
+ MouseAlike2->unimport();
+}
+
+
+ok( ! Bar->can('has'),
+ 'No has sub in Bar after MouseAlike2 is unimported' );
+ok( Bar->can('meta'),
+ 'Bar has a meta method' );
+isa_ok( Bar->meta(), 'Mouse::Meta::Class' );
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use lib 't/lib', 'lib';
+
+use Test::More tests => 91;
+use Test::Exception;
+
+use Mouse::Util::MetaRole;
+
+
+{
+ package My::Meta::Class;
+ use Mouse;
+ extends 'Mouse::Meta::Class';
+}
+
+{
+ package Role::Foo;
+ use Mouse::Role;
+ has 'foo' => ( is => 'ro', default => 10 );
+}
+
+{
+ package My::Class;
+
+ use Mouse;
+}
+
+{
+ package My::Role;
+ use Mouse::Role;
+}
+
+{
+ Mouse::Util::MetaRole::apply_metaclass_roles(
+ for_class => My::Class->meta,
+ metaclass_roles => ['Role::Foo'],
+ );
+
+ ok( My::Class->meta()->meta()->does_role('Role::Foo'),
+ 'apply Role::Foo to My::Class->meta()' );
+ is( My::Class->meta()->foo(), 10,
+ '... and call foo() on that meta object' );
+}
+
+{
+ Mouse::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Class',
+ attribute_metaclass_roles => ['Role::Foo'],
+ );
+
+ ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
+ q{apply Role::Foo to My::Class->meta()'s attribute metaclass} );
+ ok( My::Class->meta()->meta()->does_role('Role::Foo'),
+ '... My::Class->meta() still does Role::Foo' );
+
+ My::Class->meta()->add_attribute( 'size', is => 'ro' );
+ is( My::Class->meta()->get_attribute('size')->foo(), 10,
+ '... call foo() on an attribute metaclass object' );
+}
+
+{
+ Mouse::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Class',
+ method_metaclass_roles => ['Role::Foo'],
+ );
+
+ ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
+ q{apply Role::Foo to My::Class->meta()'s method metaclass} );
+ 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_method( 'bar' => sub { 'bar' } );
+ is( My::Class->meta()->get_method('bar')->foo(), 10,
+ '... call foo() on a method metaclass object' );
+}
+
+{
+ Mouse::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' );
+}
+
+{
+ Mouse::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Class',
+ instance_metaclass_roles => ['Role::Foo'],
+ );
+
+ ok( My::Class->meta()->instance_metaclass()->meta()->does_role('Role::Foo'),
+ q{apply Role::Foo to My::Class->meta()'s instance metaclass} );
+ 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} );
+ ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
+ q{... My::Class->meta()'s method metaclass still does Role::Foo} );
+
+ is( My::Class->meta()->get_meta_instance()->foo(), 10,
+ '... call foo() on an instance metaclass object' );
+}
+
+{
+ Mouse::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Class',
+ constructor_class_roles => ['Role::Foo'],
+ );
+
+ ok( My::Class->meta()->constructor_class()->meta()->does_role('Role::Foo'),
+ q{apply Role::Foo to My::Class->meta()'s constructor class} );
+ 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} );
+ ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
+ q{... My::Class->meta()'s method metaclass still does Role::Foo} );
+ ok( My::Class->meta()->instance_metaclass()->meta()->does_role('Role::Foo'),
+ q{... My::Class->meta()'s instance metaclass still does Role::Foo} );
+
+ # Actually instantiating the constructor class is too freaking hard!
+ ok( My::Class->meta()->constructor_class()->can('foo'),
+ '... constructor class has a foo method' );
+}
+
+{
+ Mouse::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Class',
+ destructor_class_roles => ['Role::Foo'],
+ );
+
+ ok( My::Class->meta()->destructor_class()->meta()->does_role('Role::Foo'),
+ q{apply Role::Foo to My::Class->meta()'s destructor class} );
+ 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} );
+ ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
+ q{... My::Class->meta()'s method metaclass still does Role::Foo} );
+ ok( My::Class->meta()->instance_metaclass()->meta()->does_role('Role::Foo'),
+ q{... My::Class->meta()'s instance metaclass still does Role::Foo} );
+ ok( My::Class->meta()->constructor_class()->meta()->does_role('Role::Foo'),
+ q{... My::Class->meta()'s constructor class still does Role::Foo} );
+
+ # same problem as the constructor class
+ ok( My::Class->meta()->destructor_class()->can('foo'),
+ '... destructor class has a foo method' );
+}
+
+{
+ Mouse::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Role',
+ application_to_class_class_roles => ['Role::Foo'],
+ );
+
+ ok( My::Role->meta->application_to_class_class->meta->does_role('Role::Foo'),
+ q{apply Role::Foo to My::Role->meta's application_to_class class} );
+
+ is( My::Role->meta->application_to_class_class->new->foo, 10,
+ q{... call foo() on an application_to_class instance} );
+}
+
+{
+ Mouse::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Role',
+ application_to_role_class_roles => ['Role::Foo'],
+ );
+
+ ok( My::Role->meta->application_to_role_class->meta->does_role('Role::Foo'),
+ q{apply Role::Foo to My::Role->meta's application_to_role class} );
+ ok( My::Role->meta->application_to_class_class->meta->does_role('Role::Foo'),
+ q{... My::Role->meta's application_to_class class still does Role::Foo} );
+
+ is( My::Role->meta->application_to_role_class->new->foo, 10,
+ q{... call foo() on an application_to_role instance} );
+}
+
+{
+ Mouse::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Role',
+ application_to_instance_class_roles => ['Role::Foo'],
+ );
+
+ ok( My::Role->meta->application_to_instance_class->meta->does_role('Role::Foo'),
+ q{apply Role::Foo to My::Role->meta's application_to_instance class} );
+ ok( My::Role->meta->application_to_role_class->meta->does_role('Role::Foo'),
+ q{... My::Role->meta's application_to_role class still does Role::Foo} );
+ ok( My::Role->meta->application_to_class_class->meta->does_role('Role::Foo'),
+ q{... My::Role->meta's application_to_class class still does Role::Foo} );
+
+ is( My::Role->meta->application_to_instance_class->new->foo, 10,
+ q{... call foo() on an application_to_instance instance} );
+}
+
+{
+ Mouse::Util::MetaRole::apply_base_class_roles(
+ for_class => 'My::Class',
+ roles => ['Role::Foo'],
+ );
+
+ ok( My::Class->meta()->does_role('Role::Foo'),
+ 'apply Role::Foo to My::Class base class' );
+ is( My::Class->new()->foo(), 10,
+ '... call foo() on a My::Class object' );
+}
+
+{
+ package My::Class2;
+
+ use Mouse;
+}
+
+{
+ Mouse::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Class2',
+ metaclass_roles => ['Role::Foo'],
+ attribute_metaclass_roles => ['Role::Foo'],
+ method_metaclass_roles => ['Role::Foo'],
+ instance_metaclass_roles => ['Role::Foo'],
+ constructor_class_roles => ['Role::Foo'],
+ destructor_class_roles => ['Role::Foo'],
+ );
+
+ ok( My::Class2->meta()->meta()->does_role('Role::Foo'),
+ 'apply Role::Foo to My::Class2->meta()' );
+ is( My::Class2->meta()->foo(), 10,
+ '... and call foo() on that meta object' );
+ ok( My::Class2->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
+ q{apply Role::Foo to My::Class2->meta()'s attribute metaclass} );
+ My::Class2->meta()->add_attribute( 'size', is => 'ro' );
+
+ is( My::Class2->meta()->get_attribute('size')->foo(), 10,
+ '... call foo() on an attribute metaclass object' );
+
+ ok( My::Class2->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
+ q{apply Role::Foo to My::Class2->meta()'s method metaclass} );
+
+ My::Class2->meta()->add_method( 'bar' => sub { 'bar' } );
+ is( My::Class2->meta()->get_method('bar')->foo(), 10,
+ '... call foo() on a method metaclass object' );
+
+ ok( My::Class2->meta()->instance_metaclass()->meta()->does_role('Role::Foo'),
+ q{apply Role::Foo to My::Class2->meta()'s instance metaclass} );
+ is( My::Class2->meta()->get_meta_instance()->foo(), 10,
+ '... call foo() on an instance metaclass object' );
+
+ ok( My::Class2->meta()->constructor_class()->meta()->does_role('Role::Foo'),
+ q{apply Role::Foo to My::Class2->meta()'s constructor class} );
+ ok( My::Class2->meta()->constructor_class()->can('foo'),
+ '... constructor class has a foo method' );
+
+ ok( My::Class2->meta()->destructor_class()->meta()->does_role('Role::Foo'),
+ q{apply Role::Foo to My::Class2->meta()'s destructor class} );
+ ok( My::Class2->meta()->destructor_class()->can('foo'),
+ '... destructor class has a foo method' );
+}
+
+
+{
+ package My::Meta;
+
+ use Mouse::Exporter;
+ Mouse::Exporter->setup_import_methods( also => 'Mouse' );
+
+ sub init_meta {
+ shift;
+ my %p = @_;
+
+ Mouse->init_meta( %p, metaclass => 'My::Meta::Class' );
+ }
+}
+
+{
+ package My::Class3;
+
+ My::Meta->import();
+}
+
+
+{
+ Mouse::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Class3',
+ metaclass_roles => ['Role::Foo'],
+ );
+
+ ok( My::Class3->meta()->meta()->does_role('Role::Foo'),
+ 'apply Role::Foo to My::Class3->meta()' );
+ is( My::Class3->meta()->foo(), 10,
+ '... and call foo() on that meta object' );
+ ok( ( grep { $_ eq 'My::Meta::Class' } My::Class3->meta()->meta()->superclasses() ),
+ 'apply_metaclass_roles() does not interfere with metaclass set via Mouse->init_meta()' );
+}
+
+{
+ package Role::Bar;
+ use Mouse::Role;
+ has 'bar' => ( is => 'ro', default => 200 );
+}
+
+{
+ package My::Class4;
+ use Mouse;
+}
+
+{
+ Mouse::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Class4',
+ metaclass_roles => ['Role::Foo'],
+ );
+
+ ok( My::Class4->meta()->meta()->does_role('Role::Foo'),
+ 'apply Role::Foo to My::Class4->meta()' );
+
+ Mouse::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Class4',
+ metaclass_roles => ['Role::Bar'],
+ );
+
+ ok( My::Class4->meta()->meta()->does_role('Role::Bar'),
+ 'apply Role::Bar to My::Class4->meta()' );
+ ok( My::Class4->meta()->meta()->does_role('Role::Foo'),
+ '... and My::Class4->meta() still does Role::Foo' );
+}
+
+{
+ package My::Class5;
+ use Mouse;
+
+ extends 'My::Class';
+}
+
+{
+ ok( My::Class5->meta()->meta()->does_role('Role::Foo'),
+ 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'),
+ q{My::Class5->meta()'s method metaclass also does Role::Foo} );
+ ok( My::Class5->meta()->instance_metaclass()->meta()->does_role('Role::Foo'),
+ q{My::Class5->meta()'s instance metaclass also does Role::Foo} );
+ ok( My::Class5->meta()->constructor_class()->meta()->does_role('Role::Foo'),
+ q{My::Class5->meta()'s constructor class also does Role::Foo} );
+ ok( My::Class5->meta()->destructor_class()->meta()->does_role('Role::Foo'),
+ q{My::Class5->meta()'s destructor class also does Role::Foo} );
+}
+
+{
+ Mouse::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Class5',
+ metaclass_roles => ['Role::Bar'],
+ );
+
+ ok( My::Class5->meta()->meta()->does_role('Role::Bar'),
+ q{apply Role::Bar My::Class5->meta()} );
+ ok( My::Class5->meta()->meta()->does_role('Role::Foo'),
+ q{... and My::Class5->meta() still does Role::Foo} );
+}
+
+{
+ package My::Class6;
+ use Mouse;
+
+ Mouse::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Class6',
+ metaclass_roles => ['Role::Bar'],
+ );
+
+ extends 'My::Class';
+}
+
+{
+ ok( My::Class6->meta()->meta()->does_role('Role::Bar'),
+ q{apply Role::Bar My::Class6->meta() before extends} );
+ ok( My::Class6->meta()->meta()->does_role('Role::Foo'),
+ q{... and My::Class6->meta() does Role::Foo because My::Class6 extends My::Class} );
+}
+
+# This is the hack that used to be needed to work around the
+# _fix_metaclass_incompatibility problem. You called extends() (which
+# in turn calls _fix_metaclass_imcompatibility) _before_ you apply
+# more extensions in the subclass. We wabt to make sure this continues
+# to work in the future.
+{
+ package My::Class7;
+ use Mouse;
+
+ # In real usage this would go in a BEGIN block so it happened
+ # before apply_metaclass_roles was called by an extension.
+ extends 'My::Class';
+
+ Mouse::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Class7',
+ metaclass_roles => ['Role::Bar'],
+ );
+}
+
+{
+ ok( My::Class7->meta()->meta()->does_role('Role::Bar'),
+ q{apply Role::Bar My::Class7->meta() before extends} );
+ ok( My::Class7->meta()->meta()->does_role('Role::Foo'),
+ q{... and My::Class7->meta() does Role::Foo because My::Class7 extends My::Class} );
+}
+
+{
+ package My::Class8;
+ use Mouse;
+
+ Mouse::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Class8',
+ metaclass_roles => ['Role::Bar'],
+ attribute_metaclass_roles => ['Role::Bar'],
+ );
+
+ extends 'My::Class';
+}
+
+{
+ ok( My::Class8->meta()->meta()->does_role('Role::Bar'),
+ q{apply Role::Bar My::Class8->meta() before extends} );
+ ok( My::Class8->meta()->meta()->does_role('Role::Foo'),
+ q{... and My::Class8->meta() does Role::Foo because My::Class8 extends My::Class} );
+ ok( My::Class8->meta()->attribute_metaclass->meta()->does_role('Role::Bar'),
+ q{apply Role::Bar to My::Class8->meta()->attribute_metaclass before extends} );
+ ok( My::Class8->meta()->attribute_metaclass->meta()->does_role('Role::Foo'),
+ q{... and My::Class8->meta()->attribute_metaclass does Role::Foo because My::Class8 extends My::Class} );
+}
+
+
+{
+ package My::Class9;
+ use Mouse;
+
+ Mouse::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Class9',
+ attribute_metaclass_roles => ['Role::Bar'],
+ );
+
+ extends 'My::Class';
+}
+
+{
+ ok( My::Class9->meta()->meta()->does_role('Role::Foo'),
+ q{... and My::Class9->meta() does Role::Foo because My::Class9 extends My::Class} );
+ ok( My::Class9->meta()->attribute_metaclass->meta()->does_role('Role::Bar'),
+ q{apply Role::Bar to My::Class9->meta()->attribute_metaclass before extends} );
+ 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 Mouse::Meta::Class
+# itself, and then it _uses_ MouseX::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 Mouse;
+ extends 'Mouse::Meta::Class';
+
+ Mouse::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Meta::Class2',
+ metaclass_roles => ['Role::Foo'],
+ );
+}
+
+{
+ package My::Object;
+ use Mouse;
+ extends 'Mouse::Object';
+}
+
+{
+ package My::Meta2;
+
+ use Mouse::Exporter;
+ Mouse::Exporter->setup_import_methods( also => 'Mouse' );
+
+ sub init_meta {
+ shift;
+ my %p = @_;
+
+ Mouse->init_meta(
+ %p,
+ metaclass => 'My::Meta::Class2',
+ base_class => 'My::Object',
+ );
+ }
+}
+
+{
+ package My::Class10;
+ My::Meta2->import;
+
+ Mouse::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 'Mouse::Meta::Method::Constructor';
+}
+
+{
+ package My::Class11;
+
+ use Mouse;
+
+ __PACKAGE__->meta->constructor_class('My::Constructor');
+
+ Mouse::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 ExportsMouse;
+
+ Mouse::Exporter->setup_import_methods(
+ also => 'Mouse',
+ );
+
+ sub init_meta {
+ shift;
+ my %p = @_;
+ Mouse->init_meta(%p);
+ return Mouse::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 UsesExportedMouse;
+ ExportsMouse->import;
+} 'import module which loads a role from disk during init_meta';
+
+{
+ package Foo::Meta::Role;
+
+ use Mouse::Role;
+}
+{
+ package Foo::Role;
+
+ Mouse::Exporter->setup_import_methods(
+ also => 'Mouse::Role',
+ );
+
+ sub init_meta {
+ shift;
+ my %p = @_;
+ Mouse::Role->init_meta(%p);
+ return Mouse::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 Mouse;
+
+ 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'
+ );
+}
+
+{
+ package Parent;
+ use Mouse;
+
+ Mouse::Util::MetaRole::apply_metaclass_roles(
+ for_class => __PACKAGE__,
+ constructor_class_roles => ['Role::Foo'],
+ );
+}
+
+{
+ package Child;
+
+ use Mouse;
+ extends 'Parent';
+}
+
+{
+ ok(
+ Parent->meta->constructor_class->meta->can('does_role')
+ && Parent->meta->constructor_class->meta->does_role('Role::Foo'),
+ 'Parent constructor class has metarole from Parent'
+ );
+
+TODO:
+ {
+ local $TODO
+ = 'Mouse does not see that the child differs from the parent because it only checks the class and instance metaclasses do determine compatibility';
+ ok(
+ Child->meta->constructor_class->meta->can('does_role')
+ && Child->meta->constructor_class->meta->does_role(
+ 'Role::Foo'),
+ 'Child constructor class has metarole from Parent'
+ );
+ }
+}
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 8;
+
+use Mouse::Util::MetaRole;
+
+BEGIN
+{
+ package My::Meta::Class;
+ use Mouse;
+ extends 'Mouse::Meta::Class';
+}
+
+BEGIN
+{
+ package My::Meta::Attribute;
+ use Mouse;
+ extends 'Mouse::Meta::Attribute';
+}
+
+BEGIN
+{
+ package My::Meta::Method;
+ use Mouse;
+ extends 'Mouse::Meta::Method';
+}
+
+BEGIN
+{
+ package My::Meta::Instance;
+ use Mouse;
+ extends 'Mouse::Meta::Instance';
+}
+
+BEGIN
+{
+ package Role::Foo;
+ use Mouse::Role;
+ has 'foo' => ( is => 'ro', default => 10 );
+}
+
+{
+ package My::Class;
+
+ use metaclass 'My::Meta::Class';
+ use Mouse;
+}
+
+{
+ package My::Class2;
+
+ use metaclass 'My::Meta::Class' => (
+ attribute_metaclass => 'My::Meta::Attribute',
+ method_metaclass => 'My::Meta::Method',
+ instance_metaclass => 'My::Meta::Instance',
+ );
+
+ use Mouse;
+}
+
+{
+ Mouse::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Class',
+ metaclass_roles => ['Role::Foo'],
+ );
+
+ ok( My::Class->meta()->meta()->does_role('Role::Foo'),
+ 'apply Role::Foo to My::Class->meta()' );
+ has_superclass( My::Class->meta(), 'My::Meta::Class',
+ 'apply_metaclass_roles works with metaclass.pm' );
+}
+
+{
+ Mouse::Util::MetaRole::apply_metaclass_roles(
+ for_class => 'My::Class2',
+ attribute_metaclass_roles => ['Role::Foo'],
+ method_metaclass_roles => ['Role::Foo'],
+ instance_metaclass_roles => ['Role::Foo'],
+ );
+
+ ok( My::Class2->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
+ q{apply Role::Foo to My::Class2->meta()'s attribute metaclass} );
+ has_superclass( My::Class2->meta()->attribute_metaclass(), 'My::Meta::Attribute',
+ '... and this does not interfere with attribute metaclass set via metaclass.pm' );
+ ok( My::Class2->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
+ q{apply Role::Foo to My::Class2->meta()'s method metaclass} );
+ has_superclass( My::Class2->meta()->method_metaclass(), 'My::Meta::Method',
+ '... and this does not interfere with method metaclass set via metaclass.pm' );
+ ok( My::Class2->meta()->instance_metaclass()->meta()->does_role('Role::Foo'),
+ q{apply Role::Foo to My::Class2->meta()'s instance metaclass} );
+ has_superclass( My::Class2->meta()->instance_metaclass(), 'My::Meta::Instance',
+ '... and this does not interfere with instance metaclass set via metaclass.pm' );
+}
+
+# like isa_ok but works with a class name, not just refs
+sub has_superclass {
+ my $thing = shift;
+ my $parent = shift;
+ my $desc = shift;
+
+ my %supers = map { $_ => 1 } $thing->meta()->superclasses();
+
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+
+ ok( $supers{$parent}, $desc );
+}
--- /dev/null
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 4;
+use Test::Exception;
+
+{
+ package NoOpTrait;
+ use Mouse::Role;
+}
+
+{
+ package Parent;
+ use Mouse -traits => 'NoOpTrait';
+
+ has attr => (
+ is => 'rw',
+ isa => 'Str',
+ );
+}
+
+{
+ package Child;
+ use base 'Parent';
+}
+
+is(Child->meta->name, 'Child', "correct metaclass name");
+
+my $child = Child->new(attr => "ibute");
+ok($child, "constructor works");
+
+is($child->attr, "ibute", "getter inherited properly");
+
+$child->attr("ition");
+is($child->attr, "ition", "setter inherited properly");
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 24;
+use Test::Exception;
+
+{
+
+ package Foo;
+ use Mouse;
+
+ has foo => ( is => "ro" );
+
+ package Bar;
+ use metaclass (
+ metaclass => "Mouse::Meta::Class",
+ error_class => "Mouse::Error::Croak",
+ );
+ use Mouse;
+
+ has foo => ( is => "ro" );
+
+ package Baz::Error;
+ use Mouse;
+
+ has message => ( isa => "Str", is => "ro" );
+ has attr => ( isa => "Mouse::Meta::Attribute", is => "ro" );
+ has method => ( isa => "Mouse::Meta::Method", is => "ro" );
+ has metaclass => ( isa => "Mouse::Meta::Class", is => "ro" );
+ has data => ( is => "ro" );
+ has line => ( isa => "Int", is => "ro" );
+ has file => ( isa => "Str", is => "ro" );
+ has last_error => ( isa => "Any", is => "ro" );
+
+ package Baz;
+ use metaclass (
+ metaclass => "Mouse::Meta::Class",
+ error_class => "Baz::Error",
+ );
+ use Mouse;
+
+ has foo => ( is => "ro" );
+}
+
+my $line;
+sub blah { $line = __LINE__; shift->foo(4) }
+
+sub create_error {
+ eval {
+ eval { die "Blah" };
+ blah(shift);
+ };
+ ok( my $e = $@, "got some error" );
+ return {
+ file => __FILE__,
+ line => $line,
+ error => $e,
+ };
+}
+
+{
+ my $e = create_error( Foo->new );
+ ok( !ref( $e->{error} ), "error is a string" );
+ like( $e->{error}, qr/line $e->{line}\n.*\n/s, "confess" );
+}
+
+{
+ my $e = create_error( Bar->new );
+ ok( !ref( $e->{error} ), "error is a string" );
+ like( $e->{error}, qr/line $e->{line}$/s, "croak" );
+}
+
+{
+ my $e = create_error( my $baz = Baz->new );
+ isa_ok( $e->{error}, "Baz::Error" );
+ unlike( $e->{error}->message, qr/line $e->{line}/s,
+ "no line info, just a message" );
+ isa_ok( $e->{error}->metaclass, "Mouse::Meta::Class", "metaclass" );
+ is( $e->{error}->metaclass, Baz->meta, "metaclass value" );
+ isa_ok( $e->{error}->attr, "Mouse::Meta::Attribute", "attr" );
+ is( $e->{error}->attr, Baz->meta->get_attribute("foo"), "attr value" );
+ isa_ok( $e->{error}->method, "Mouse::Meta::Method", "method" );
+ is( $e->{error}->method, Baz->meta->get_method("foo"), "method value" );
+ is( $e->{error}->line, $e->{line}, "line attr" );
+ is( $e->{error}->file, $e->{file}, "file attr" );
+ is_deeply( $e->{error}->data, [ $baz, 4 ], "captured args" );
+ like( $e->{error}->last_error, qr/Blah/, "last error preserved" );
+}
+
+{
+ package Role::Foo;
+ use Mouse::Role;
+
+ sub foo { }
+}
+
+{
+ package Baz::Sub;
+
+ use Mouse;
+ extends 'Baz';
+
+ Mouse::Util::MetaRole::apply_metaclass_roles(
+ for_class => __PACKAGE__,
+ metaclass_roles => ['Role::Foo'],
+ );
+}
+
+{
+ package Baz::Sub::Sub;
+ use metaclass (
+ metaclass => 'Mouse::Meta::Class',
+ error_class => 'Mouse::Error::Croak',
+ );
+ use Mouse;
+
+ ::dies_ok { extends 'Baz::Sub' } 'error_class is included in metaclass compatibility checks';
+}
+
+{
+ package Foo::Sub;
+
+ use metaclass (
+ metaclass => 'Mouse::Meta::Class',
+ error_class => 'Mouse::Error::Croak',
+ );
+
+ use Mouse;
+
+ Mouse::Util::MetaRole::apply_metaclass_roles(
+ for_class => __PACKAGE__,
+ metaclass_roles => ['Role::Foo'],
+ );
+}
+
+ok( Foo::Sub->meta->error_class->isa('Mouse::Error::Croak'),
+ q{Foo::Sub's error_class still isa Mouse::Error::Croak} );
+
+{
+ package Foo::Sub::Sub;
+ use Mouse;
+
+ ::lives_ok { extends 'Foo::Sub' } 'error_class differs by role so incompat is handled';
+
+ Mouse::Util::MetaRole::apply_metaclass_roles(
+ for_class => __PACKAGE__,
+ error_class_roles => ['Role::Foo'],
+ );
+}
+
+ok( Foo::Sub::Sub->meta->error_class->meta->does_role('Role::Foo'),
+ q{Foo::Sub::Sub's error_class does Role::Foo} );
+ok( Foo::Sub::Sub->meta->error_class->isa('Mouse::Error::Croak'),
+ q{Foo::Sub::Sub's error_class now subclasses Mouse::Error::Croak} );
--- /dev/null
+#!/usr/bin/perl
+
+# this functionality may be pushing toward parametric roles/classes
+# it's off in a corner and may not be that important
+
+use strict;
+use warnings;
+
+use Test::More tests => 15;
+use Test::Exception;
+
+{
+ package HasFoo;
+ use Mouse::Role;
+ has 'foo' => (
+ is => 'ro',
+ isa => 'Str',
+ required => 1,
+ );
+
+}
+
+{
+ package My::Metaclass;
+ use Mouse;
+ extends 'Mouse::Meta::Class';
+ with 'HasFoo';
+}
+
+package main;
+
+my $anon;
+lives_ok {
+ $anon = My::Metaclass->create_anon_class( foo => 'this' );
+} 'create anon class with required attr';
+isa_ok( $anon, 'My::Metaclass' );
+cmp_ok( $anon->foo, 'eq', 'this', 'foo is this' );
+dies_ok {
+ $anon = My::Metaclass->create_anon_class();
+} 'failed to create anon class without required attr';
+
+my $meta;
+lives_ok {
+ $meta
+ = My::Metaclass->initialize( 'Class::Name1' => ( foo => 'that' ) );
+} 'initialize a class with required attr';
+isa_ok( $meta, 'My::Metaclass' );
+cmp_ok( $meta->foo, 'eq', 'that', 'foo is that' );
+cmp_ok( $meta->name, 'eq', 'Class::Name1', 'for the correct class' );
+dies_ok {
+ $meta
+ = My::Metaclass->initialize( 'Class::Name2' );
+} 'failed to initialize a class without required attr';
+
+lives_ok {
+ eval qq{
+ package Class::Name3;
+ use metaclass 'My::Metaclass' => (
+ foo => 'another',
+ );
+ use Mouse;
+ };
+ die $@ if $@;
+} 'use metaclass with required attr';
+$meta = Class::Name3->meta;
+isa_ok( $meta, 'My::Metaclass' );
+cmp_ok( $meta->foo, 'eq', 'another', 'foo is another' );
+cmp_ok( $meta->name, 'eq', 'Class::Name3', 'for the correct class' );
+dies_ok {
+ eval qq{
+ package Class::Name4;
+ use metaclass 'My::Metaclass';
+ use Mouse;
+ };
+ die $@ if $@;
+} 'failed to use metaclass without required attr';
+
+
+# how do we pass a required attribute to -traits?
+dies_ok {
+ eval qq{
+ package Class::Name5;
+ use Mouse -traits => 'HasFoo';
+ };
+ die $@ if $@;
+} 'failed to use trait without required attr';
+
--- /dev/null
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More tests => 5;
+
+{
+ package My::Trait;
+ use Mouse::Role;
+
+ sub reversed_name {
+ my $self = shift;
+ scalar reverse $self->name;
+ }
+}
+
+{
+ package My::Class;
+ use Mouse -traits => [
+ 'My::Trait' => {
+ -alias => {
+ reversed_name => 'enam',
+ },
+ },
+ ];
+}
+
+{
+ package My::Other::Class;
+ use Mouse -traits => [
+ 'My::Trait' => {
+ -alias => {
+ reversed_name => 'reversed',
+ },
+ -excludes => 'reversed_name',
+ },
+ ];
+}
+
+my $meta = My::Class->meta;
+is($meta->enam, 'ssalC::yM', 'parameterized trait applied');
+ok(!$meta->can('reversed'), "the method was not installed under the other class' alias");
+
+my $other_meta = My::Other::Class->meta;
+is($other_meta->reversed, 'ssalC::rehtO::yM', 'parameterized trait applied');
+ok(!$other_meta->can('enam'), "the method was not installed under the other class' alias");
+ok(!$other_meta->can('reversed_name'), "the method was not installed under the original name when that was excluded");
+
--- /dev/null
+use lib "t/lib";
+package MyExporter::User;
+use MyExporter;
+
+use Test::More (tests => 4);
+use Test::Exception;
+
+lives_and {
+ with_prototype {
+ my $caller = caller(0);
+ is($caller, 'MyExporter', "With_caller prototype code gets called from MyMouseX");
+ };
+} "check function with prototype";
+
+lives_and {
+ as_is_prototype {
+ my $caller = caller(0);
+ is($caller, 'MyExporter', "As-is prototype code gets called from MyMouseX");
+ };
+} "check function with prototype";
--- /dev/null
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More tests => 2;
+
+do {
+ package My::Meta::Class;
+ use Mouse;
+ BEGIN { extends 'Mouse::Meta::Class' };
+
+ package Mouse::Meta::Class::Custom::MyMetaClass;
+ sub register_implementation { 'My::Meta::Class' }
+};
+
+do {
+ package My::Class;
+ use Mouse -metaclass => 'My::Meta::Class';
+};
+
+do {
+ package My::Class::Aliased;
+ use Mouse -metaclass => 'MyMetaClass';
+};
+
+is(My::Class->meta->meta->name, 'My::Meta::Class');
+is(My::Class::Aliased->meta->meta->name, 'My::Meta::Class');
+
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 13;
+use Test::Mouse qw(does_ok);
+
+{
+ package Foo::Trait::Class;
+ use Mouse::Role;
+}
+
+{
+ package Foo::Trait::Attribute;
+ use Mouse::Role;
+}
+
+{
+ package Foo::Role::Base;
+ use Mouse::Role;
+}
+
+{
+ package Foo::Exporter;
+ use Mouse::Exporter;
+
+ Mouse::Exporter->setup_import_methods(
+ metaclass_roles => ['Foo::Trait::Class'],
+ attribute_metaclass_roles => ['Foo::Trait::Attribute'],
+ base_class_roles => ['Foo::Role::Base'],
+ );
+}
+
+{
+ package Foo;
+ use Mouse;
+ Foo::Exporter->import;
+
+ has foo => (is => 'ro');
+
+ ::does_ok(Foo->meta, 'Foo::Trait::Class');
+ ::does_ok(Foo->meta->get_attribute('foo'), 'Foo::Trait::Attribute');
+ ::does_ok('Foo', 'Foo::Role::Base');
+}
+
+{
+ package Foo::Exporter::WithMouse;
+ use Mouse ();
+ use Mouse::Exporter;
+
+ my ($import, $unimport, $init_meta) =
+ Mouse::Exporter->build_import_methods(
+ also => 'Mouse',
+ metaclass_roles => ['Foo::Trait::Class'],
+ attribute_metaclass_roles => ['Foo::Trait::Attribute'],
+ base_class_roles => ['Foo::Role::Base'],
+ install => [qw(import unimport)],
+ );
+
+ sub init_meta {
+ my $package = shift;
+ my %options = @_;
+ ::pass('custom init_meta was called');
+ Mouse->init_meta(%options);
+ return $package->$init_meta(%options);
+ }
+}
+
+{
+ package Foo2;
+ Foo::Exporter::WithMouse->import;
+
+ has(foo => (is => 'ro'));
+
+ ::isa_ok('Foo2', 'Mouse::Object');
+ ::isa_ok(Foo2->meta, 'Mouse::Meta::Class');
+ ::does_ok(Foo2->meta, 'Foo::Trait::Class');
+ ::does_ok(Foo2->meta->get_attribute('foo'), 'Foo::Trait::Attribute');
+ ::does_ok('Foo2', 'Foo::Role::Base');
+}
+
+{
+ package Foo::Role;
+ use Mouse::Role;
+ Foo::Exporter->import;
+
+ ::does_ok(Foo::Role->meta, 'Foo::Trait::Class');
+}
+
+{
+ package Foo::Exporter::WithMouseRole;
+ use Mouse::Role ();
+ use Mouse::Exporter;
+
+ my ($import, $unimport, $init_meta) =
+ Mouse::Exporter->build_import_methods(
+ also => 'Mouse::Role',
+ metaclass_roles => ['Foo::Trait::Class'],
+ attribute_metaclass_roles => ['Foo::Trait::Attribute'],
+ base_class_roles => ['Foo::Role::Base'],
+ install => [qw(import unimport)],
+ );
+
+ sub init_meta {
+ my $package = shift;
+ my %options = @_;
+ ::pass('custom init_meta was called');
+ Mouse::Role->init_meta(%options);
+ return $package->$init_meta(%options);
+ }
+}
+
+{
+ package Foo2::Role;
+ Foo::Exporter::WithMouseRole->import;
+
+ ::isa_ok(Foo2::Role->meta, 'Mouse::Meta::Role');
+ ::does_ok(Foo2::Role->meta, 'Foo::Trait::Class');
+}
--- /dev/null
+use strict;
+use warnings;
+use Test::More;
+
+our @applications;
+
+{
+ package CustomApplication;
+ use Mouse::Role;
+
+ after apply_methods => sub {
+ my ( $self, $role, $other ) = @_;
+ $self->apply_custom( $role, $other );
+ };
+
+ sub apply_custom {
+ shift;
+ push @applications, [@_];
+ }
+}
+
+{
+ package CustomApplication::ToClass;
+ use Mouse::Role;
+
+ with 'CustomApplication';
+}
+
+{
+ package CustomApplication::ToRole;
+ use Mouse::Role;
+
+ with 'CustomApplication';
+}
+
+{
+ package CustomApplication::ToInstance;
+ use Mouse::Role;
+
+ with 'CustomApplication';
+}
+
+{
+ package CustomApplication::Composite;
+ use Mouse::Role;
+
+ with 'CustomApplication';
+
+ around apply_custom => sub {
+ my ( $next, $self, $composite, $other ) = @_;
+ for my $role ( @{ $composite->get_roles } ) {
+ $self->$next( $role, $other );
+ }
+ };
+}
+
+{
+ package CustomApplication::Composite::ToClass;
+ use Mouse::Role;
+
+ with 'CustomApplication::Composite';
+}
+
+{
+ package CustomApplication::Composite::ToRole;
+ use Mouse::Role;
+
+ with 'CustomApplication::Composite';
+}
+
+{
+ package CustomApplication::Composite::ToInstance;
+ use Mouse::Role;
+
+ with 'CustomApplication::Composite';
+}
+
+{
+ package Role::Composite;
+ use Mouse::Role;
+
+ around apply_params => sub {
+ my ( $next, $self, @args ) = @_;
+ return Mouse::Util::MetaRole::apply_metaclass_roles(
+ for_class => $self->$next(@args),
+ application_to_class_class_roles =>
+ ['CustomApplication::Composite::ToClass'],
+ application_to_role_class_roles =>
+ ['CustomApplication::Composite::ToRole'],
+ application_to_instance_class_roles =>
+ ['CustomApplication::Composite::ToInstance'],
+ );
+ };
+}
+
+{
+ package Role::WithCustomApplication;
+ use Mouse::Role;
+
+ has '+composition_class_roles' => (
+ default => ['Role::Composite'],
+ );
+}
+
+{
+ package CustomRole;
+ Mouse::Exporter->setup_import_methods(
+ also => 'Mouse::Role',
+ );
+
+ sub init_meta {
+ my ( $self, %options ) = @_;
+ return Mouse::Util::MetaRole::apply_metaclass_roles(
+ for_class => Mouse::Role->init_meta(%options),
+ metaclass_roles => ['Role::WithCustomApplication'],
+ application_to_class_class_roles =>
+ ['CustomApplication::ToClass'],
+ application_to_role_class_roles => ['CustomApplication::ToRole'],
+ application_to_instance_class_roles =>
+ ['CustomApplication::ToInstance'],
+ );
+ }
+}
+
+{
+ package My::Role::Normal;
+ use Mouse::Role;
+}
+
+{
+ package My::Role::Special;
+ CustomRole->import;
+}
+
+ok( My::Role::Normal->meta->isa('Mouse::Meta::Role'), "sanity check" );
+ok( My::Role::Special->meta->isa('Mouse::Meta::Role'),
+ "using custom application roles does not change the role metaobject's class"
+);
+ok( My::Role::Special->meta->meta->does_role('Role::WithCustomApplication'),
+ "the role's metaobject has custom applications" );
+is_deeply( My::Role::Special->meta->composition_class_roles,
+ ['Role::Composite'],
+ "the role knows about the specified composition class" );
+
+{
+ package Foo;
+ use Mouse;
+
+ local @applications;
+ with 'My::Role::Special';
+
+ ::is( @applications, 1, 'one role application' );
+ ::is( $applications[0]->[0]->name, 'My::Role::Special',
+ "the application's first role was My::Role::Special'" );
+ ::is( $applications[0]->[1]->name, 'Foo',
+ "the application provided an additional role" );
+}
+
+{
+ package Bar;
+ use Mouse::Role;
+
+ local @applications;
+ with 'My::Role::Special';
+
+ ::is( @applications, 1 );
+ ::is( $applications[0]->[0]->name, 'My::Role::Special' );
+ ::is( $applications[0]->[1]->name, 'Bar' );
+}
+
+{
+ package Baz;
+ use Mouse;
+
+ my $i = Baz->new;
+ local @applications;
+ My::Role::Special->meta->apply($i);
+
+ ::is( @applications, 1 );
+ ::is( $applications[0]->[0]->name, 'My::Role::Special' );
+ ::ok( $applications[0]->[1]->is_anon_class );
+ ::ok( $applications[0]->[1]->name->isa('Baz') );
+}
+
+{
+ package Corge;
+ use Mouse;
+
+ local @applications;
+ with 'My::Role::Normal', 'My::Role::Special';
+
+ ::is( @applications, 2 );
+ ::is( $applications[0]->[0]->name, 'My::Role::Normal' );
+ ::is( $applications[0]->[1]->name, 'Corge' );
+ ::is( $applications[1]->[0]->name, 'My::Role::Special' );
+ ::is( $applications[1]->[1]->name, 'Corge' );
+}
+
+{
+ package Thud;
+ use Mouse::Role;
+
+ local @applications;
+ with 'My::Role::Normal', 'My::Role::Special';
+
+ ::is( @applications, 2 );
+ ::is( $applications[0]->[0]->name, 'My::Role::Normal' );
+ ::is( $applications[0]->[1]->name, 'Thud' );
+ ::is( $applications[1]->[0]->name, 'My::Role::Special' );
+ ::is( $applications[1]->[1]->name, 'Thud' );
+}
+
+{
+ package Garply;
+ use Mouse;
+
+ my $i = Garply->new;
+ local @applications;
+ Mouse::Meta::Role->combine(
+ [ 'My::Role::Normal' => undef ],
+ [ 'My::Role::Special' => undef ],
+ )->apply($i);
+
+ ::is( @applications, 2 );
+ ::is( $applications[0]->[0]->name, 'My::Role::Normal' );
+ ::ok( $applications[0]->[1]->is_anon_class );
+ ::ok( $applications[0]->[1]->name->isa('Garply') );
+ ::is( $applications[1]->[0]->name, 'My::Role::Special' );
+ ::ok( $applications[1]->[1]->is_anon_class );
+ ::ok( $applications[1]->[1]->name->isa('Garply') );
+}
+
+done_testing;
--- /dev/null
+use strict;
+use warnings;
+{
+ package My::Role;
+ use Mouse::Role;
+}
+{
+ package SomeClass;
+ use Mouse -traits => 'My::Role';
+}
+{
+ package SubClassUseBase;
+ use base qw/SomeClass/;
+}
+{
+ package SubSubClassUseBase;
+ use base qw/SubClassUseBase/;
+}
+
+use Test::More tests => 2;
+use Mouse::Util qw/find_meta does_role/;
+
+my $subsubclass_meta = Mouse->init_meta( for_class => 'SubSubClassUseBase' );
+ok does_role($subsubclass_meta, 'My::Role'),
+ 'SubSubClass metaclass does role from grandparent metaclass';
+my $subclass_meta = find_meta('SubClassUseBase');
+ok does_role($subclass_meta, 'My::Role'),
+ 'SubClass metaclass does role from parent metaclass';
--- /dev/null
+use strict;
+use warnings;
+{
+ package ParentClass;
+ use Mouse;
+}
+{
+ package SomeClass;
+ use base 'ParentClass';
+}
+{
+ package SubClassUseBase;
+ use base qw/SomeClass/;
+ use Mouse;
+}
+
+use Test::More tests => 1;
+use Test::Exception;
+
+lives_ok {
+ Mouse->init_meta(for_class => 'SomeClass');
+} 'Mouse class => use base => Mouse Class, then Mouse->init_meta on middle class ok';
projects / gitmo/Mouse.git / commitdiff