summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJesse Luehrs <doy@tozt.net>2010-07-19 19:10:14 -0500
committerJesse Luehrs <doy@tozt.net>2010-07-19 19:10:14 -0500
commit636f22f307ff0dc94a2c2ec23d49c872ecddbc02 (patch)
treedab6dc4bc564c61d6a1ace5727238574cfd5ce2b
parentbdd9773b60d3cf2cceea43b4aa1dacd9ed5d492b (diff)
downloadmoosex-exporter-easy-636f22f307ff0dc94a2c2ec23d49c872ecddbc02.tar.gz
moosex-exporter-easy-636f22f307ff0dc94a2c2ec23d49c872ecddbc02.zip
initial implementation
-rw-r--r--lib/MooseX/Exporter/Easy.pm72
-rw-r--r--lib/MooseX/Exporter/Easy/Meta/Role/Package.pm128
-rw-r--r--t/lib/MyExporter.pm21
-rw-r--r--t/lib/MyMetaclassRole.pm4
-rw-r--r--t/moose/007_always_strict_warnings.t71
-rw-r--r--t/moose/012_moose_exporter.t371
-rw-r--r--t/moose/015_metarole.t685
-rw-r--r--t/moose/021_export_with_prototype.t22
-rw-r--r--t/moose/023_easy_init_meta.t126
-rw-r--r--t/moose/030_metarole_combination.t240
-rw-r--r--t/moose/moose_cookbook_extending_recipe2.t65
-rw-r--r--t/moose/moose_cookbook_extending_recipe3.t77
-rw-r--r--t/moose/moose_cookbook_extending_recipe4.t67
13 files changed, 1949 insertions, 0 deletions
diff --git a/lib/MooseX/Exporter/Easy.pm b/lib/MooseX/Exporter/Easy.pm
index e69de29..f6d4d5b 100644
--- a/lib/MooseX/Exporter/Easy.pm
+++ b/lib/MooseX/Exporter/Easy.pm
@@ -0,0 +1,72 @@
+package MooseX::Exporter::Easy;
+use Moose ();
+use Moose::Exporter;
+
+use Carp qw(confess);
+use Scalar::Util qw(blessed);
+
+Moose::Exporter->setup_import_methods(
+ with_meta => [qw(with_meta as_is also
+ class_metaroles role_metaroles base_class_roles
+ export)],
+);
+
+sub with_meta {
+ my ($meta, $name, $sub) = @_;
+ confess "with_meta requires a name and a sub to export"
+ unless defined($name) && defined($sub) && ref($sub) eq 'CODE';
+ $meta->add_with_meta($name, $sub);
+}
+
+sub as_is {
+ my ($meta, $name, $sub) = @_;
+ confess "as_is requires a name and a sub to export"
+ unless defined($name) && defined($sub) && ref($sub) eq 'CODE';
+ $meta->add_as_is($name, $sub);
+}
+
+sub also {
+ my ($meta, @also) = @_;
+ $meta->add_also(@also);
+}
+
+sub class_metaroles {
+ my ($meta, $roles) = @_;
+ $meta->class_metaroles($roles);
+}
+
+sub role_metaroles {
+ my ($meta, $roles) = @_;
+ $meta->role_metaroles($roles);
+}
+
+sub base_class_roles {
+ my ($meta, @roles) = @_;
+ $meta->add_base_class_roles(@roles);
+}
+
+sub export {
+ my ($meta) = @_;
+ $meta->setup_exporter;
+}
+
+# move this into Moose::Util?
+sub with_traits {
+ my ($class, @roles) = @_;
+ return Moose::Meta::Class->create_anon_class(
+ superclasses => [$class],
+ roles => \@roles,
+ cache => 1,
+ )->name;
+}
+
+sub init_meta {
+ my $package = shift;
+ my %opts = @_;
+ my $meta_name = blessed(Class::MOP::class_of($opts{for_class}))
+ || 'Class::MOP::Package';
+ $meta_name = with_traits($meta_name, 'MooseX::Exporter::Easy::Meta::Role::Package');
+ my $meta = $meta_name->reinitialize($opts{for_class});
+}
+
+1;
diff --git a/lib/MooseX/Exporter/Easy/Meta/Role/Package.pm b/lib/MooseX/Exporter/Easy/Meta/Role/Package.pm
new file mode 100644
index 0000000..755b50a
--- /dev/null
+++ b/lib/MooseX/Exporter/Easy/Meta/Role/Package.pm
@@ -0,0 +1,128 @@
+package MooseX::Exporter::Easy::Meta::Role::Package;
+use Moose::Role;
+
+has with_meta => (
+ traits => ['Array'],
+ isa => 'ArrayRef[Str]',
+ default => sub { [] },
+ handles => {
+ with_meta => 'elements',
+ _add_with_meta => 'push',
+ }
+);
+
+sub add_with_meta {
+ my $self = shift;
+ my ($name, $sub) = @_;
+ $self->add_package_symbol('&' . $name, $sub);
+ $self->_add_with_meta($name);
+}
+
+has as_is => (
+ traits => ['Array'],
+ isa => 'ArrayRef[Str]',
+ default => sub { [] },
+ handles => {
+ as_is => 'elements',
+ _add_as_is => 'push',
+ }
+);
+
+sub add_as_is {
+ my $self = shift;
+ my ($name, $sub) = @_;
+ $self->add_package_symbol('&' . $name, $sub);
+ $self->_add_as_is($name);
+}
+
+has also => (
+ traits => ['Array'],
+ isa => 'ArrayRef[Str]',
+ default => sub { [] },
+ handles => {
+ also => 'elements',
+ add_also => 'push',
+ }
+);
+
+has class_metaroles => (
+ is => 'rw',
+ isa => 'HashRef[ArrayRef[Str]]',
+ predicate => 'has_class_metaroles',
+);
+
+has role_metaroles => (
+ is => 'rw',
+ isa => 'HashRef[ArrayRef[Str]]',
+ predicate => 'has_role_metaroles',
+);
+
+has base_class_roles => (
+ traits => ['Array'],
+ isa => 'ArrayRef[Str]',
+ default => sub { [] },
+ handles => {
+ base_class_roles => 'elements',
+ add_base_class_roles => 'push',
+ has_base_class_roles => 'count',
+ }
+);
+
+sub setup_exporter {
+ my $self = shift;;
+
+ my ($import, $unimport, $init_meta) = Moose::Exporter->build_import_methods(
+ exporting_package => $self->name,
+ with_meta => [$self->with_meta],
+ as_is => [$self->as_is],
+ also => [$self->also],
+ $self->has_class_metaroles
+ ? (class_metaroles => $self->class_metaroles)
+ : (),
+ $self->has_role_metaroles
+ ? (role_metaroles => $self->role_metaroles)
+ : (),
+ $self->has_base_class_roles
+ ? (base_class_roles => [$self->base_class_roles])
+ : (),
+ );
+
+ $self->add_package_symbol('&import' =>
+ ($self->has_package_symbol('&import_extra')
+ ? sub {
+ my ($package, @args) = @_;
+ $package->import_extra(@args);
+ goto $import;
+ }
+ : $import)
+ );
+ $self->add_package_symbol('&unimport' =>
+ ($self->has_package_symbol('&unimport_extra')
+ ? sub {
+ my ($package, @args) = @_;
+ $package->unimport_extra(@args);
+ goto $unimport;
+ }
+ : $unimport)
+ );
+ if ($init_meta) {
+ $self->add_package_symbol('&init_meta' =>
+ ($self->has_package_symbol('&init_meta_extra')
+ ? sub {
+ my ($package, @args) = @_;
+ $package->init_meta_extra(@args);
+ goto $init_meta;
+ }
+ : $init_meta)
+ );
+ }
+ elsif ($self->has_package_symbol('&init_meta_extra')) {
+ $self->add_package_symbol('&init_meta' =>
+ sub { goto $_[0]->can('init_meta_extra') }
+ );
+ }
+}
+
+no Moose::Role;
+
+1;
diff --git a/t/lib/MyExporter.pm b/t/lib/MyExporter.pm
new file mode 100644
index 0000000..a29fff0
--- /dev/null
+++ b/t/lib/MyExporter.pm
@@ -0,0 +1,21 @@
+
+
+package MyExporter;
+use MooseX::Exporter::Easy;
+use Test::More;
+
+with_meta with_prototype => sub (&) {
+ my ($meta, $code) = @_;
+ isa_ok($code, 'CODE', 'with_prototype received a coderef');
+ $code->();
+};
+
+as_is as_is_prototype => sub (&) {
+ my ($code) = @_;
+ isa_ok($code, 'CODE', 'as_is_prototype received a coderef');
+ $code->();
+};
+
+export;
+
+1;
diff --git a/t/lib/MyMetaclassRole.pm b/t/lib/MyMetaclassRole.pm
new file mode 100644
index 0000000..362265a
--- /dev/null
+++ b/t/lib/MyMetaclassRole.pm
@@ -0,0 +1,4 @@
+package MyMetaclassRole;
+use Moose::Role;
+
+1;
diff --git a/t/moose/007_always_strict_warnings.t b/t/moose/007_always_strict_warnings.t
new file mode 100644
index 0000000..c09e9d7
--- /dev/null
+++ b/t/moose/007_always_strict_warnings.t
@@ -0,0 +1,71 @@
+#!/usr/bin/perl
+
+use Test::More;
+
+# for classes ...
+{
+ package Foo;
+ use Moose;
+
+ eval '$foo = 5;';
+ ::ok($@, '... got an error because strict is on');
+ ::like($@, qr/Global symbol \"\$foo\" requires explicit package name at/, '... got the right error');
+
+ {
+ my $warn;
+ local $SIG{__WARN__} = sub { $warn = $_[0] };
+
+ ::ok(!$warn, '... no warning yet');
+
+ eval 'my $bar = 1 + "hello"';
+
+ ::ok($warn, '... got a warning');
+ ::like($warn, qr/Argument \"hello\" isn\'t numeric in addition \(\+\)/, '.. and it is the right warning');
+ }
+}
+
+# and for roles ...
+{
+ package Bar;
+ use Moose::Role;
+
+ eval '$foo = 5;';
+ ::ok($@, '... got an error because strict is on');
+ ::like($@, qr/Global symbol \"\$foo\" requires explicit package name at/, '... got the right error');
+
+ {
+ my $warn;
+ local $SIG{__WARN__} = sub { $warn = $_[0] };
+
+ ::ok(!$warn, '... no warning yet');
+
+ eval 'my $bar = 1 + "hello"';
+
+ ::ok($warn, '... got a warning');
+ ::like($warn, qr/Argument \"hello\" isn\'t numeric in addition \(\+\)/, '.. and it is the right warning');
+ }
+}
+
+# and for exporters
+{
+ package Bar;
+ use MooseX::Exporter::Easy;
+
+ eval '$foo = 5;';
+ ::ok($@, '... got an error because strict is on');
+ ::like($@, qr/Global symbol \"\$foo\" requires explicit package name at/, '... got the right error');
+
+ {
+ my $warn;
+ local $SIG{__WARN__} = sub { $warn = $_[0] };
+
+ ::ok(!$warn, '... no warning yet');
+
+ eval 'my $bar = 1 + "hello"';
+
+ ::ok($warn, '... got a warning');
+ ::like($warn, qr/Argument \"hello\" isn\'t numeric in addition \(\+\)/, '.. and it is the right warning');
+ }
+}
+
+done_testing;
diff --git a/t/moose/012_moose_exporter.t b/t/moose/012_moose_exporter.t
new file mode 100644
index 0000000..937649e
--- /dev/null
+++ b/t/moose/012_moose_exporter.t
@@ -0,0 +1,371 @@
+#!/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 $@;
+}
+
+
+{
+ package HasOwnImmutable;
+
+ use Moose;
+
+ no Moose;
+
+ ::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 MooseX::Empty;
+
+ use Moose ();
+ use MooseX::Exporter::Easy;
+ also 'Moose';
+ export;
+}
+
+{
+ package WantsMoose;
+
+ MooseX::Empty->import();
+
+ sub foo { 1 }
+
+ ::can_ok( 'WantsMoose', 'has' );
+ ::can_ok( 'WantsMoose', 'with' );
+ ::can_ok( 'WantsMoose', 'foo' );
+
+ MooseX::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( ! WantsMoose->can('has'), 'WantsMoose::has() has been cleaned' );
+ ok( ! WantsMoose->can('with'), 'WantsMoose::with() has been cleaned' );
+ can_ok( 'WantsMoose', 'foo' );
+
+ # This makes sure that Moose->init_meta() happens properly
+ isa_ok( WantsMoose->meta(), 'Moose::Meta::Class' );
+ isa_ok( WantsMoose->new(), 'Moose::Object' );
+
+}
+
+{
+ package MooseX::Sugar;
+
+ use Moose ();
+ use MooseX::Exporter::Easy;
+
+ also 'Moose';
+
+ with_meta wrapped1 => sub {
+ my $meta = shift;
+ return $meta->name . ' called wrapped1';
+ };
+
+ export;
+}
+
+{
+ package WantsSugar;
+
+ MooseX::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' );
+
+ MooseX::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 MooseX::MoreSugar;
+
+ use Moose ();
+ use MooseX::Exporter::Easy;
+
+ also 'MooseX::Sugar';
+
+ with_meta wrapped2 => sub {
+ my $meta = shift;
+ return $meta->name . ' called wrapped2';
+ };
+
+ as_is as_is1 => sub {
+ return 'as_is1';
+ };
+
+ export;
+}
+
+{
+ package WantsMoreSugar;
+
+ MooseX::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' );
+
+ MooseX::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 Moose;
+ BEGIN { extends 'Moose::Meta::Class' }
+
+ package My::Object;
+ use Moose;
+ BEGIN { extends 'Moose::Object' }
+
+ package HasInitMeta;
+
+ use Moose ();
+ use MooseX::Exporter::Easy;
+
+ also 'Moose';
+
+ sub init_meta_extra {
+ shift;
+ return Moose->init_meta( @_,
+ metaclass => 'My::Metaclass',
+ base_class => 'My::Object',
+ );
+ }
+
+ export;
+}
+
+{
+ package NewMeta;
+
+ HasInitMeta->import();
+}
+
+{
+ isa_ok( NewMeta->meta(), 'My::Metaclass' );
+ isa_ok( NewMeta->new(), 'My::Object' );
+}
+
+{
+ package MooseX::CircularAlso;
+
+ use Moose ();
+ use MooseX::Exporter::Easy;
+ also 'Moose', 'MooseX::CircularAlso';
+
+ ::dies_ok(
+ sub { export },
+ 'a circular reference in also dies with an error'
+ );
+
+ ::like(
+ $@,
+ qr/\QCircular reference in 'also' parameter to Moose::Exporter between MooseX::CircularAlso and MooseX::CircularAlso/,
+ 'got the expected error from circular reference in also'
+ );
+}
+
+{
+ package MooseX::NoAlso;
+
+ use Moose ();
+ use MooseX::Exporter::Easy;
+
+ also 'NoSuchThing';
+
+ ::dies_ok(
+ sub { export },
+ 'a package which does not use Moose::Exporter in also dies with an error'
+ );
+
+ ::like(
+ $@,
+ qr/\QPackage in also (NoSuchThing) does not seem to use Moose::Exporter (is it loaded?) at /,
+ 'got the expected error from a reference in also to a package which is not loaded'
+ );
+}
+
+{
+ package MooseX::NotExporter;
+
+ use Moose ();
+ use MooseX::Exporter::Easy;
+
+ also 'Moose::Meta::Method';
+
+ ::dies_ok(
+ sub { export },
+ 'a package which does not use Moose::Exporter in also dies with an error'
+ );
+
+ ::like(
+ $@,
+ qr/\QPackage in also (Moose::Meta::Method) does not seem to use Moose::Exporter at /,
+ 'got the expected error from a reference in also to a package which does not use Moose::Exporter'
+ );
+}
+
+{
+ package MooseX::OverridingSugar;
+
+ use Moose ();
+ use MooseX::Exporter::Easy;
+
+ also 'Moose';
+
+ with_meta has => sub {
+ my $meta = shift;
+ return $meta->name . ' called has';
+ };
+
+ export;
+}
+
+{
+ package WantsOverridingSugar;
+
+ MooseX::OverridingSugar->import();
+
+ ::can_ok( 'WantsOverridingSugar', 'has' );
+ ::can_ok( 'WantsOverridingSugar', 'with' );
+ ::is( has('foo'), 'WantsOverridingSugar called has',
+ 'has from MooseX::OverridingSugar is called, not has from Moose' );
+
+ MooseX::OverridingSugar->unimport();
+}
+
+{
+ ok( ! WantsSugar->can('has'), 'WantsSugar::has() has been cleaned' );
+ ok( ! WantsSugar->can('with'), 'WantsSugar::with() has been cleaned' );
+}
+
+{
+ package NonExistentExport;
+
+ use Moose ();
+ use MooseX::Exporter::Easy;
+
+ also 'Moose';
+
+ ::throws_ok {
+ with_meta 'does_not_exist';
+ } qr/with_meta requires a name and a sub to export/,
+ "dies when a function to export isn't passed";
+
+ export;
+}
+
+{
+ package WantsNonExistentExport;
+
+ NonExistentExport->import;
+
+ ::ok(!__PACKAGE__->can('does_not_exist'),
+ "undefined subs do not get exported");
+}
+
+{
+ package AllOptions;
+ use Moose ();
+ use MooseX::Exporter::Easy;
+
+ also 'Moose';
+
+ as_is as_is1 => sub {2};
+
+ with_meta with_meta1 => sub {
+ return @_;
+ };
+
+ with_meta with_meta2 => sub (&) {
+ return @_;
+ };
+
+ export;
+}
+
+{
+ package UseAllOptions;
+
+ AllOptions->import();
+}
+
+{
+ can_ok( 'UseAllOptions', $_ )
+ for qw( with_meta1 with_meta2 as_is1 );
+
+ {
+ my ( $meta, $arg1 ) = UseAllOptions::with_meta1(42);
+ isa_ok( $meta, 'Moose::Meta::Class', 'with_meta first argument' );
+ is( $arg1, 42, 'with_meta1 returns argument it was passed' );
+ }
+
+ 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 as_is1 );
+}
+
+done_testing;
diff --git a/t/moose/015_metarole.t b/t/moose/015_metarole.t
new file mode 100644
index 0000000..dc8e7d9
--- /dev/null
+++ b/t/moose/015_metarole.t
@@ -0,0 +1,685 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use lib 't/lib', 'lib';
+
+use Test::More;
+use Test::Exception;
+
+use Moose::Util::MetaRole;
+
+
+{
+ package My::Meta::Class;
+ use Moose;
+ extends 'Moose::Meta::Class';
+}
+
+{
+ package Role::Foo;
+ use Moose::Role;
+ has 'foo' => ( is => 'ro', default => 10 );
+}
+
+{
+ package My::Class;
+
+ use Moose;
+}
+
+{
+ package My::Role;
+ use Moose::Role;
+}
+
+{
+ Moose::Util::MetaRole::apply_metaroles(
+ for => My::Class->meta,
+ class_metaroles => { class => ['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' );
+}
+
+{
+ Moose::Util::MetaRole::apply_metaroles(
+ for => 'My::Class',
+ class_metaroles => { attribute => ['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' );
+}
+
+{
+ Moose::Util::MetaRole::apply_metaroles(
+ for => 'My::Class',
+ class_metaroles => { method => ['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' );
+}
+
+{
+ Moose::Util::MetaRole::apply_metaroles(
+ for => 'My::Class',
+ class_metaroles => { wrapped_method => ['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_metaroles(
+ for => 'My::Class',
+ class_metaroles => { instance => ['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' );
+}
+
+{
+ Moose::Util::MetaRole::apply_metaroles(
+ for => 'My::Class',
+ class_metaroles => { constructor => ['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' );
+}
+
+{
+ Moose::Util::MetaRole::apply_metaroles(
+ for => 'My::Class',
+ class_metaroles => { destructor => ['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' );
+}
+
+{
+ Moose::Util::MetaRole::apply_metaroles(
+ for => 'My::Role',
+ role_metaroles => { application_to_class => ['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} );
+}
+
+{
+ Moose::Util::MetaRole::apply_metaroles(
+ for => 'My::Role',
+ role_metaroles => { application_to_role => ['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} );
+}
+
+{
+ Moose::Util::MetaRole::apply_metaroles(
+ for => 'My::Role',
+ role_metaroles => { application_to_instance => ['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} );
+}
+
+{
+ Moose::Util::MetaRole::apply_base_class_roles(
+ for => '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 Moose;
+}
+
+{
+ Moose::Util::MetaRole::apply_metaroles(
+ for => 'My::Class2',
+ class_metaroles => {
+ class => ['Role::Foo'],
+ attribute => ['Role::Foo'],
+ method => ['Role::Foo'],
+ instance => ['Role::Foo'],
+ constructor => ['Role::Foo'],
+ destructor => ['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 MooseX::Exporter::Easy;
+
+ also 'Moose';
+
+ sub init_meta_extra {
+ shift;
+ my %p = @_;
+
+ Moose->init_meta( %p, metaclass => 'My::Meta::Class' );
+ }
+
+ export;
+}
+
+{
+ package My::Class3;
+
+ My::Meta->import();
+}
+
+
+{
+ Moose::Util::MetaRole::apply_metaroles(
+ for => 'My::Class3',
+ class_metaroles => { class => ['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_metaroles() does not interfere with metaclass set via Moose->init_meta()' );
+}
+
+{
+ package Role::Bar;
+ use Moose::Role;
+ has 'bar' => ( is => 'ro', default => 200 );
+}
+
+{
+ package My::Class4;
+ use Moose;
+}
+
+{
+ Moose::Util::MetaRole::apply_metaroles(
+ for => 'My::Class4',
+ class_metaroles => { class => ['Role::Foo'] },
+ );
+
+ ok( My::Class4->meta()->meta()->does_role('Role::Foo'),
+ 'apply Role::Foo to My::Class4->meta()' );
+
+ Moose::Util::MetaRole::apply_metaroles(
+ for => 'My::Class4',
+ class_metaroles => { class => ['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 Moose;
+
+ 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} );
+}
+
+{
+ Moose::Util::MetaRole::apply_metaroles(
+ for => 'My::Class5',
+ class_metaroles => { class => ['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 Moose;
+
+ Moose::Util::MetaRole::apply_metaroles(
+ for => 'My::Class6',
+ class_metaroles => { class => ['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 Moose;
+
+ # In real usage this would go in a BEGIN block so it happened
+ # before apply_metaroles was called by an extension.
+ extends 'My::Class';
+
+ Moose::Util::MetaRole::apply_metaroles(
+ for => 'My::Class7',
+ class_metaroles => { class => ['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 Moose;
+
+ Moose::Util::MetaRole::apply_metaroles(
+ for => 'My::Class8',
+ class_metaroles => {
+ class => ['Role::Bar'],
+ attribute => ['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 Moose;
+
+ Moose::Util::MetaRole::apply_metaroles(
+ for => 'My::Class9',
+ class_metaroles => { attribute => ['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 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_metaroles(
+ for => 'My::Meta::Class2',
+ class_metaroles => { class => ['Role::Foo'] },
+ );
+}
+
+{
+ package My::Object;
+ use Moose;
+ extends 'Moose::Object';
+}
+
+{
+ package My::Meta2;
+
+ use MooseX::Exporter::Easy;
+
+ also 'Moose';
+
+ sub init_meta_extra {
+ shift;
+ my %p = @_;
+
+ Moose->init_meta(
+ %p,
+ metaclass => 'My::Meta::Class2',
+ base_class => 'My::Object',
+ );
+ }
+
+ export;
+}
+
+{
+ package My::Class10;
+ My::Meta2->import;
+
+ Moose::Util::MetaRole::apply_metaroles(
+ for => 'My::Class10',
+ class_metaroles => { class => ['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_metaroles(
+ for => 'My::Class11',
+ class_metaroles => { class => ['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;
+
+ use MooseX::Exporter::Easy;
+
+ also 'Moose';
+
+ sub init_meta_extra {
+ shift;
+ my %p = @_;
+ Moose->init_meta(%p);
+ return Moose::Util::MetaRole::apply_metaroles(
+ for_class => $p{for_class},
+ # Causes us to recurse through init_meta, as we have to
+ # load MyMetaclassRole from disk.
+ metaclass_roles => [qw/MyMetaclassRole/],
+ );
+ }
+
+ export;
+}
+
+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;
+
+ use MooseX::Exporter::Easy;
+
+ also 'Moose::Role';
+
+ sub init_meta_extra {
+ shift;
+ my %p = @_;
+
+ Moose::Role->init_meta(%p);
+
+ return Moose::Util::MetaRole::apply_metaroles(
+ for => $p{for_class},
+ role_metaroles => { method => ['Foo::Meta::Role'] },
+ );
+ }
+
+ export;
+}
+
+{
+ 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'
+ );
+}
+
+{
+ package Parent;
+ use Moose;
+
+ Moose::Util::MetaRole::apply_metaroles(
+ for => __PACKAGE__,
+ class_metaroles => { constructor => ['Role::Foo'] },
+ );
+}
+
+{
+ package Child;
+
+ use Moose;
+ 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'
+ );
+
+ 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'
+ );
+}
+
+done_testing;
diff --git a/t/moose/021_export_with_prototype.t b/t/moose/021_export_with_prototype.t
new file mode 100644
index 0000000..6c8f5e2
--- /dev/null
+++ b/t/moose/021_export_with_prototype.t
@@ -0,0 +1,22 @@
+use lib "t/lib";
+package MyExporter::User;
+use MyExporter;
+
+use Test::More;
+use Test::Exception;
+
+lives_and {
+ with_prototype {
+ my $caller = caller(0);
+ is($caller, 'MyExporter', "With_caller prototype code gets called from MyMooseX");
+ };
+} "check function with prototype";
+
+lives_and {
+ as_is_prototype {
+ my $caller = caller(0);
+ is($caller, 'MyExporter', "As-is prototype code gets called from MyMooseX");
+ };
+} "check function with prototype";
+
+done_testing;
diff --git a/t/moose/023_easy_init_meta.t b/t/moose/023_easy_init_meta.t
new file mode 100644
index 0000000..b54cd14
--- /dev/null
+++ b/t/moose/023_easy_init_meta.t
@@ -0,0 +1,126 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Moose qw(does_ok);
+
+{
+ package Foo::Trait::Class;
+ use Moose::Role;
+}
+
+{
+ package Foo::Trait::Attribute;
+ use Moose::Role;
+}
+
+{
+ package Foo::Role::Base;
+ use Moose::Role;
+}
+
+{
+ package Foo::Exporter;
+ use MooseX::Exporter::Easy;
+
+ class_metaroles {
+ class => ['Foo::Trait::Class'],
+ attribute => ['Foo::Trait::Attribute'],
+ };
+ role_metaroles {
+ role => ['Foo::Trait::Class'],
+ };
+ base_class_roles 'Foo::Role::Base';
+
+ export;
+}
+
+{
+ package Foo;
+ use Moose;
+ 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::WithMoose;
+ use Moose ();
+ use MooseX::Exporter::Easy;
+
+ also 'Moose';
+
+ class_metaroles {
+ class => ['Foo::Trait::Class'],
+ attribute => ['Foo::Trait::Attribute'],
+ };
+ base_class_roles 'Foo::Role::Base';
+
+ sub init_meta_extra {
+ my $package = shift;
+ my %options = @_;
+ ::pass('custom init_meta was called');
+ Moose->init_meta(%options);
+ }
+
+ export;
+}
+
+{
+ package Foo2;
+ Foo::Exporter::WithMoose->import;
+
+ has(foo => (is => 'ro'));
+
+ ::isa_ok('Foo2', 'Moose::Object');
+ ::isa_ok(Foo2->meta, 'Moose::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 Moose::Role;
+ Foo::Exporter->import;
+
+ ::does_ok(Foo::Role->meta, 'Foo::Trait::Class');
+}
+
+{
+ package Foo::Exporter::WithMooseRole;
+ use Moose::Role ();
+ use MooseX::Exporter::Easy;
+
+ also 'Moose::Role';
+
+ role_metaroles {
+ role => ['Foo::Trait::Class'],
+ attribute => ['Foo::Trait::Attribute'],
+ };
+
+ sub init_meta_extra {
+ my $package = shift;
+ my %options = @_;
+ ::pass('custom init_meta was called');
+ Moose::Role->init_meta(%options);
+ }
+
+ export;
+}
+
+{
+ package Foo2::Role;
+ Foo::Exporter::WithMooseRole->import;
+
+ ::isa_ok(Foo2::Role->meta, 'Moose::Meta::Role');
+ ::does_ok(Foo2::Role->meta, 'Foo::Trait::Class');
+}
+
+done_testing;
diff --git a/t/moose/030_metarole_combination.t b/t/moose/030_metarole_combination.t
new file mode 100644
index 0000000..a045df2
--- /dev/null
+++ b/t/moose/030_metarole_combination.t
@@ -0,0 +1,240 @@
+use strict;
+use warnings;
+use Test::More;
+
+our @applications;
+
+{
+ package CustomApplication;
+ use Moose::Role;
+
+ after apply_methods => sub {
+ my ( $self, $role, $other ) = @_;
+ $self->apply_custom( $role, $other );
+ };
+
+ sub apply_custom {
+ shift;
+ push @applications, [@_];
+ }
+}
+
+{
+ package CustomApplication::ToClass;
+ use Moose::Role;
+
+ with 'CustomApplication';
+}
+
+{
+ package CustomApplication::ToRole;
+ use Moose::Role;
+
+ with 'CustomApplication';
+}
+
+{
+ package CustomApplication::ToInstance;
+ use Moose::Role;
+
+ with 'CustomApplication';
+}
+
+{
+ package CustomApplication::Composite;
+ use Moose::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 Moose::Role;
+
+ with 'CustomApplication::Composite';
+}
+
+{
+ package CustomApplication::Composite::ToRole;
+ use Moose::Role;
+
+ with 'CustomApplication::Composite';
+}
+
+{
+ package CustomApplication::Composite::ToInstance;
+ use Moose::Role;
+
+ with 'CustomApplication::Composite';
+}
+
+{
+ package Role::Composite;
+ use Moose::Role;
+
+ around apply_params => sub {
+ my ( $next, $self, @args ) = @_;
+ return Moose::Util::MetaRole::apply_metaroles(
+ for => $self->$next(@args),
+ role_metaroles => {
+ application_to_class =>
+ ['CustomApplication::Composite::ToClass'],
+ application_to_role =>
+ ['CustomApplication::Composite::ToRole'],
+ application_to_instance =>
+ ['CustomApplication::Composite::ToInstance'],
+ },
+ );
+ };
+}
+
+{
+ package Role::WithCustomApplication;
+ use Moose::Role;
+
+ around composition_class_roles => sub {
+ my ($orig, $self) = @_;
+ return $self->$orig, 'Role::Composite';
+ };
+}
+
+{
+ package CustomRole;
+ use MooseX::Exporter::Easy;
+
+ also 'Moose::Role';
+
+ sub init_meta_extra {
+ my ( $self, %options ) = @_;
+ return Moose::Util::MetaRole::apply_metaroles(
+ for_class => Moose::Role->init_meta(%options),
+ role_metaroles => {
+ role => ['Role::WithCustomApplication'],
+ application_to_class =>
+ ['CustomApplication::ToClass'],
+ application_to_role => ['CustomApplication::ToRole'],
+ application_to_instance =>
+ ['CustomApplication::ToInstance'],
+ },
+ );
+ }
+
+ export;
+}
+
+{
+ package My::Role::Normal;
+ use Moose::Role;
+}
+
+{
+ package My::Role::Special;
+ CustomRole->import;
+}
+
+ok( My::Role::Normal->meta->isa('Moose::Meta::Role'), "sanity check" );
+ok( My::Role::Special->meta->isa('Moose::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 Moose;
+
+ 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 Moose::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 Moose;
+
+ 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 Moose;
+
+ 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 Moose::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 Moose;
+
+ my $i = Garply->new;
+ local @applications;
+ Moose::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;
diff --git a/t/moose/moose_cookbook_extending_recipe2.t b/t/moose/moose_cookbook_extending_recipe2.t
new file mode 100644
index 0000000..763586e
--- /dev/null
+++ b/t/moose/moose_cookbook_extending_recipe2.t
@@ -0,0 +1,65 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More 'no_plan';
+use Test::Exception;
+$| = 1;
+
+
+
+# =begin testing SETUP
+BEGIN {
+ eval 'use Test::Output;';
+ if ($@) {
+ diag 'Test::Output is required for this test';
+ ok(1);
+ exit 0;
+ }
+}
+
+
+
+# =begin testing SETUP
+{
+
+ package MooseX::Debugging;
+
+ use MooseX::Exporter::Easy;
+
+ base_class_roles 'MooseX::Debugging::Role::Object';
+
+ export;
+
+ package MooseX::Debugging::Role::Object;
+
+ use Moose::Role;
+
+ after 'BUILDALL' => sub {
+ my $self = shift;
+
+ warn "Made a new " . ( ref $self ) . " object\n";
+ };
+}
+
+
+
+# =begin testing
+{
+{
+ package Debugged;
+
+ use Moose;
+ MooseX::Debugging->import;
+}
+
+stderr_is(
+ sub { Debugged->new },
+ "Made a new Debugged object\n",
+ 'got expected output from debugging role'
+);
+}
+
+
+
+
+1;
diff --git a/t/moose/moose_cookbook_extending_recipe3.t b/t/moose/moose_cookbook_extending_recipe3.t
new file mode 100644
index 0000000..98ef077
--- /dev/null
+++ b/t/moose/moose_cookbook_extending_recipe3.t
@@ -0,0 +1,77 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More 'no_plan';
+use Test::Exception;
+$| = 1;
+
+
+
+# =begin testing SETUP
+BEGIN {
+ eval 'use Test::Output;';
+ if ($@) {
+ diag 'Test::Output is required for this test';
+ ok(1);
+ exit 0;
+ }
+}
+
+
+
+# =begin testing SETUP
+{
+
+ package MyApp::Base;
+ use Moose;
+
+ extends 'Moose::Object';
+
+ before 'new' => sub { warn "Making a new " . $_[0] };
+
+ no Moose;
+
+ package MyApp::UseMyBase;
+ use Moose ();
+ use MooseX::Exporter::Easy;
+
+ also 'Moose';
+
+ sub init_meta_extra {
+ shift;
+ return Moose->init_meta( @_, base_class => 'MyApp::Base' );
+ }
+
+ export;
+}
+
+
+
+# =begin testing
+{
+{
+ package Foo;
+
+ MyApp::UseMyBase->import;
+
+ has( 'size' => ( is => 'rw' ) );
+}
+
+ok( Foo->isa('MyApp::Base'), 'Foo isa MyApp::Base' );
+
+ok( Foo->can('size'), 'Foo has a size method' );
+
+my $foo;
+stderr_like(
+ sub { $foo = Foo->new( size => 2 ) },
+ qr/^Making a new Foo/,
+ 'got expected warning when calling Foo->new'
+);
+
+is( $foo->size(), 2, '$foo->size is 2' );
+}
+
+
+
+
+1;
diff --git a/t/moose/moose_cookbook_extending_recipe4.t b/t/moose/moose_cookbook_extending_recipe4.t
new file mode 100644
index 0000000..1a41093
--- /dev/null
+++ b/t/moose/moose_cookbook_extending_recipe4.t
@@ -0,0 +1,67 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More 'no_plan';
+use Test::Exception;
+$| = 1;
+
+
+
+# =begin testing SETUP
+{
+
+ package MyApp::Mooseish;
+
+ use Moose ();
+ use MooseX::Exporter::Easy;
+
+ also 'Moose';
+
+ sub init_meta_extra {
+ shift;
+ return Moose->init_meta( @_, metaclass => 'MyApp::Meta::Class' );
+ }
+
+ with_meta has_table => sub {
+ my $meta = shift;
+ $meta->table(shift);
+ };
+
+ export;
+
+ package MyApp::Meta::Class;
+ use Moose;
+
+ extends 'Moose::Meta::Class';
+
+ has 'table' => ( is => 'rw' );
+}
+
+
+
+# =begin testing
+{
+{
+ package MyApp::User;
+
+ MyApp::Mooseish->import;
+
+ has_table( 'User' );
+
+ has( 'username' => ( is => 'ro' ) );
+ has( 'password' => ( is => 'ro' ) );
+
+ sub login { }
+}
+
+isa_ok( MyApp::User->meta, 'MyApp::Meta::Class' );
+is( MyApp::User->meta->table, 'User',
+ 'MyApp::User->meta->table returns User' );
+ok( MyApp::User->can('username'),
+ 'MyApp::User has username method' );
+}
+
+
+
+
+1;