From: Dave Rolsky Date: Mon, 4 Jan 2010 17:35:32 +0000 (-0600) Subject: Merged topic/metarole-distinguishes-role-meta (which includes topic/roles-have-real... X-Git-Tag: 0.93_01~10 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f785aad8b8e799322985d8acce2bcb88fadc24a0;p=gitmo%2FMoose.git Merged topic/metarole-distinguishes-role-meta (which includes topic/roles-have-real-attributes as well). This adds real attributes to roles, and makes some changes to the Moose::Util::MetaRole API so that users must specify roles for class metaclasses separately from those for role metaclasses. Squashed commit of the following: commit a6f4f4f4743cc87e8aadbed00312761af15c6822 Merge: 0ed066c 9cc63d2 Author: Dave Rolsky Date: Mon Jan 4 11:35:25 2010 -0600 merge master commit 0ed066c7e278e360d4b7d857ddad84681be9e8ce Author: Dave Rolsky Date: Mon Jan 4 11:02:55 2010 -0600 add docs for Moose::Meta::Mixin::AttributeCore commit 5ac94c7e9ee3e0d5bd14f82d62ed90176812afa6 Merge: daf482a 301a2fc Author: Dave Rolsky Date: Mon Jan 4 11:01:52 2010 -0600 Merge branch 'master' into topic/metarole-distinguishes-role-meta Conflicts: Changes commit daf482a1ca9af2de141e8c7c03c9fc6cbddd5feb Author: Dave Rolsky Date: Mon Jan 4 11:00:13 2010 -0600 Add docs for Moose::Meta::Role::Attribute commit 6b8b7a05f80ce96a0ecb3bf3962fc6ebd6d1e2e3 Author: Dave Rolsky Date: Mon Jan 4 10:50:47 2010 -0600 Add exclusions for new methods that don't need docs commit 61917ede2a286042153f2bd058e90af6274b597b Author: Dave Rolsky Date: Mon Jan 4 10:48:52 2010 -0600 Add metaroles to spelling whitelist commit 5f242ef82a127bea0fa2b630f7a278b02ac5a49e Author: Dave Rolsky Date: Sun Jan 3 00:04:56 2010 -0600 Remove 0.94 versoin # in the wrong place commit 7a89f4e0c62338622e2573508e41469bf61f5f4b Author: Dave Rolsky Date: Sun Jan 3 00:04:42 2010 -0600 Changes for next version commit ae9042be1aca7d300f67ddccf57833f80dada106 Author: Dave Rolsky Date: Sun Jan 3 00:03:17 2010 -0600 Changes for next version commit 9559e5012a59abe4fb13d255de413122beb80528 Author: Dave Rolsky Date: Sat Jan 2 23:59:47 2010 -0600 Tweak docs for new MetaRole api commit 806f607b78a1eac6ca588101e8cb0b747a3034f9 Author: Dave Rolsky Date: Sat Jan 2 23:58:14 2010 -0600 Update MetaRole docs commit 2bbe680397f1474d2099a6f05c805b3f07ba3513 Author: Dave Rolsky Date: Sat Jan 2 17:12:03 2010 -0600 More conflicts commit e821045d525f71ebba74389887b612cab71a5913 Merge: 109ab37 8fa582b Author: Dave Rolsky Date: Sat Jan 2 16:58:10 2010 -0600 Merge branch 'master' into topic/metarole-distinguishes-role-meta commit 109ab377fcb4636f9052015b752bed588da63d20 Author: Dave Rolsky Date: Sat Jan 2 16:15:37 2010 -0600 update conflicts list commit 5aafe28556af230278fe7bd631c40b0aaf55452b Author: Dave Rolsky Date: Fri Jan 1 12:54:48 2010 -0600 New MetaRole API to distinguish role & class metaroles. Made ->reinitialize always preserve existing helper metaclasses for both MMC and MMR. commit 5f4bdda79ff5bd89dd0f8763f4c313d9e2f4fff8 Author: Dave Rolsky Date: Wed Dec 30 11:24:39 2009 -0600 Distinguish between metaroles for a class metaclass and role metaclass. This means prefixing the options for MetaRole with "role_" - "role_metaclass_roles", "role_attribute_metaclass_roles", etc. commit bed6f91f547d5f335c51434dbf0694cc06d103fb Merge: 9addd62 4701cef Author: Dave Rolsky Date: Mon Dec 28 16:41:06 2009 -0600 Merge branch 'master' into topic/roles-have-real-attributes Conflicts: lib/Moose/Meta/Role.pm t/050_metaclasses/030_metarole_combination.t commit 9addd624375d5fe4b11a8e8022e19a116eda78c4 Merge: 05c1cb1 c5e3151 Author: Dave Rolsky Date: Mon Dec 28 14:21:54 2009 -0600 Merge branch 'master' into topic/roles-have-real-attributes commit 05c1cb1dccaeb28231972d5d08396f2c4bb64fd0 Author: Dave Rolsky Date: Mon Dec 28 11:21:51 2009 -0600 When comparing attributes during role summation, we need to compare them with an API, not just by comparing their refaddrs. Added an ->is_same_as method to MMR::Attribute. This compares the values of ->original_options for the two objects. commit 1fc6c93bbdee6e07f3c06f46f33a717e5eb85d85 Author: Dave Rolsky Date: Mon Dec 28 11:08:09 2009 -0600 rename AttributeBase -> AttributeCore commit f1eba6b3caa8244c3d831fbc220bb0357fded304 Author: Dave Rolsky Date: Sat Dec 26 13:58:53 2009 -0600 Redid role attrs to be their own class. Role attrs are cloned when added to other roles (and in role summation). Added tests for role attrs commit d1f0dd763dfb2ab8a21e7b3533b60fbd056712e0 Author: Dave Rolsky Date: Sat Dec 26 13:11:32 2009 -0600 Roles have real attributes take 2. Now role attributes a separate attribute-like class which knows how to make "real" attributes. commit 428fc71e564cf97dfdfe805b37441dfe5e4ea728 Merge: 1fcc19c 1050527 Author: Dave Rolsky Date: Fri Dec 25 10:40:08 2009 -0600 Merge branch 'master' into topic/roles-have-real-attributes commit 10505278de61bec9021b8e64614dbde5840f6954 Author: Dave Rolsky Date: Fri Dec 25 10:39:41 2009 -0600 add segfault workaround to pod spelling test commit 1fcc19ca705350013ba219b1181965b2e87b9e10 Author: Dave Rolsky Date: Thu Dec 17 14:16:07 2009 -0600 Remove some debugging cruft commit 721b5f293969f5cf1b6863fb4cc1361f4bfbb9d8 Author: Dave Rolsky Date: Thu Dec 17 11:29:55 2009 -0600 Real attribute objects in roles is now working, with a few hacks and changes to the core code. This will need serious review before merging. --- diff --git a/Changes b/Changes index 34000a8..084dead 100644 --- a/Changes +++ b/Changes @@ -1,6 +1,15 @@ Also see Moose::Manual::Delta for more details of, and workarounds for, noteworthy changes. + * Moose::Meta::Role + - Role attributes are now objects of the Moose::Meta::Role::Attribute + class. (Dave Rolsky). + + * Moose::Util::MetaRole + - Major changes to how metaroles are applied. We now distinguish between + metaroles for classes vs those for roles. See the Moose::Util::MetaRole + docs for details. (Dave Rolsky) + * Moose::Exporter - The unimport subs it generates now clean up re-exported functions like blessed and confess, unless the caller imported them from somewhere diff --git a/Makefile.PL b/Makefile.PL index 4cc7e7f..d71fd82 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -44,9 +44,10 @@ WriteAll(); sub check_conflicts { my %conflicts = ( 'Fey::ORM' => '0.23', - 'MooseX::AttributeHelpers' => '0.21', + 'MooseX::Aliases' => '0.07', + 'MooseX::AttributeHelpers' => '0.22', 'MooseX::ClassAttribute' => '0.09', - 'MooseX::MethodAttributes' => '0.15', + 'MooseX::MethodAttributes' => '0.18', 'MooseX::NonMoose' => '0.05', 'MooseX::Params::Validate' => '0.05', 'MooseX::Singleton' => '0.19', diff --git a/lib/Moose.pm b/lib/Moose.pm index 4415b2e..69cf99b 100644 --- a/lib/Moose.pm +++ b/lib/Moose.pm @@ -259,6 +259,7 @@ $_->make_immutable( Moose::Meta::Method::Augmented Moose::Meta::Role + Moose::Meta::Role::Attribute Moose::Meta::Role::Method Moose::Meta::Role::Method::Required Moose::Meta::Role::Method::Conflicting @@ -272,6 +273,11 @@ $_->make_immutable( Moose::Meta::Role::Application::ToInstance ); +Moose::Meta::Mixin::AttributeCore->meta->make_immutable( + inline_constructor => 0, + constructor_name => undef, +); + 1; __END__ diff --git a/lib/Moose/Exporter.pm b/lib/Moose/Exporter.pm index d996d92..64675d8 100644 --- a/lib/Moose/Exporter.pm +++ b/lib/Moose/Exporter.pm @@ -434,10 +434,16 @@ sub _apply_meta_traits { return unless @resolved_traits; - Moose::Util::MetaRole::apply_metaclass_roles( - for_class => $class, - metaclass_roles => \@resolved_traits, - ); + my %args = ( for => $class ); + + if ( $meta->isa('Moose::Meta::Role') ) { + $args{role_metaroles} = { role => \@resolved_traits }; + } + else { + $args{class_metaroles} = { class => \@resolved_traits }; + } + + Moose::Util::MetaRole::apply_metaroles(%args); } sub _get_caller { @@ -505,10 +511,11 @@ sub _make_init_meta { my $class = shift; my $args = shift; - my %metaclass_roles; + my %old_style_roles; for my $role ( map {"${_}_roles"} - qw(metaclass + qw( + metaclass attribute_metaclass method_metaclass wrapped_method_metaclass @@ -516,18 +523,20 @@ sub _make_init_meta { constructor_class destructor_class error_class - application_to_class_class - application_to_role_class - application_to_instance_class) + ) ) { - $metaclass_roles{$role} = $args->{$role} if exists $args->{$role}; + $old_style_roles{$role} = $args->{$role} + if exists $args->{$role}; } my %base_class_roles; %base_class_roles = ( roles => $args->{base_class_roles} ) if exists $args->{base_class_roles}; - return unless %metaclass_roles || %base_class_roles; + my %new_style_roles = map { $_ => $args->{$_} } + grep { exists $args->{$_} } qw( class_metaroles role_metaroles ); + + return unless %new_style_roles || %old_style_roles || %base_class_roles; return sub { shift; @@ -535,9 +544,10 @@ sub _make_init_meta { return unless Class::MOP::class_of( $options{for_class} ); - Moose::Util::MetaRole::apply_metaclass_roles( - for_class => $options{for_class}, - %metaclass_roles, + Moose::Util::MetaRole::apply_metaroles( + for => $options{for_class}, + %new_style_roles, + %old_style_roles, ); Moose::Util::MetaRole::apply_base_class_roles( @@ -678,9 +688,9 @@ when C is called. =back -Any of the C<*_roles> options for -C and -C are also acceptable. +You can also provide parameters for C +and C. Specifically, valid parameters +are "class_metaroles", "role_metaroles", and "base_object_roles". =item B<< Moose::Exporter->build_import_methods(...) >> diff --git a/lib/Moose/Manual/Delta.pod b/lib/Moose/Manual/Delta.pod index c0b845b..3ed438a 100644 --- a/lib/Moose/Manual/Delta.pod +++ b/lib/Moose/Manual/Delta.pod @@ -20,6 +20,22 @@ send us a patch. =over 4 +=item Moose::Util::MetaRole API has changed + +The C function is now called C. The +way arguments are supplied has been changed to force you to distinguish +between metaroles applied to L (and helpers) versus +L. + +The old API still works, but will warn in a future release, and eventually be +removed. + +=item Moose::Meta::Role has real attributes + +The attributes returned by L are now instances of the +L class, instead of bare hash references. + +<<<<<<< HEAD:lib/Moose/Manual/Delta.pod =item "no Moose" now removes C and C Moose is now smart enough to know exactly what it exported, even when it diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm index 92dc684..ba4f78f 100644 --- a/lib/Moose/Meta/Attribute.pm +++ b/lib/Moose/Meta/Attribute.pm @@ -17,38 +17,8 @@ use Moose::Meta::Method::Delegation; use Moose::Util (); use Moose::Util::TypeConstraints (); -use base 'Class::MOP::Attribute'; - -# options which are not directly used -# but we store them for metadata purposes -__PACKAGE__->meta->add_attribute('isa' => (reader => '_isa_metadata')); -__PACKAGE__->meta->add_attribute('does' => (reader => '_does_metadata')); -__PACKAGE__->meta->add_attribute('is' => (reader => '_is_metadata')); - -# these are actual options for the attrs -__PACKAGE__->meta->add_attribute('required' => (reader => 'is_required' )); -__PACKAGE__->meta->add_attribute('lazy' => (reader => 'is_lazy' )); -__PACKAGE__->meta->add_attribute('lazy_build' => (reader => 'is_lazy_build' )); -__PACKAGE__->meta->add_attribute('coerce' => (reader => 'should_coerce' )); -__PACKAGE__->meta->add_attribute('weak_ref' => (reader => 'is_weak_ref' )); -__PACKAGE__->meta->add_attribute('auto_deref' => (reader => 'should_auto_deref')); -__PACKAGE__->meta->add_attribute('type_constraint' => ( - reader => 'type_constraint', - predicate => 'has_type_constraint', -)); -__PACKAGE__->meta->add_attribute('trigger' => ( - reader => 'trigger', - predicate => 'has_trigger', -)); -__PACKAGE__->meta->add_attribute('handles' => ( - reader => 'handles', - writer => '_set_handles', - predicate => 'has_handles', -)); -__PACKAGE__->meta->add_attribute('documentation' => ( - reader => 'documentation', - predicate => 'has_documentation', -)); +use base 'Class::MOP::Attribute', 'Moose::Meta::Mixin::AttributeCore'; + __PACKAGE__->meta->add_attribute('traits' => ( reader => 'applied_traits', predicate => 'has_applied_traits', diff --git a/lib/Moose/Meta/Attribute/Native/Trait.pm b/lib/Moose/Meta/Attribute/Native/Trait.pm index 311ee28..76db962 100644 --- a/lib/Moose/Meta/Attribute/Native/Trait.pm +++ b/lib/Moose/Meta/Attribute/Native/Trait.pm @@ -34,9 +34,6 @@ has 'method_constructors' => ( }, ); -has '+default' => ( required => 1 ); -has '+type_constraint' => ( required => 1 ); - # methods called prior to instantiation before '_process_options' => sub { diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm index 7319be8..af0956d 100644 --- a/lib/Moose/Meta/Class.pm +++ b/lib/Moose/Meta/Class.pm @@ -68,6 +68,32 @@ sub initialize { ); } +sub reinitialize { + my $self = shift; + my $pkg = shift; + + my $meta = blessed $pkg ? $pkg : Class::MOP::class_of($pkg); + + my %existing_classes; + if ($meta) { + %existing_classes = map { $_ => $meta->$_() } qw( + attribute_metaclass + method_metaclass + wrapped_method_metaclass + instance_metaclass + constructor_class + destructor_class + error_class + ); + } + + return $self->SUPER::reinitialize( + $pkg, + %existing_classes, + @_, + ); +} + sub _immutable_options { my ( $self, @args ) = @_; diff --git a/lib/Moose/Meta/Mixin/AttributeCore.pm b/lib/Moose/Meta/Mixin/AttributeCore.pm new file mode 100644 index 0000000..2b231d9 --- /dev/null +++ b/lib/Moose/Meta/Mixin/AttributeCore.pm @@ -0,0 +1,77 @@ +package Moose::Meta::Mixin::AttributeCore; + +use strict; +use warnings; + +our $VERSION = '0.93'; +our $AUTHORITY = 'cpan:STEVAN'; + +use base 'Class::MOP::Mixin::AttributeCore'; + +__PACKAGE__->meta->add_attribute( 'isa' => ( reader => '_isa_metadata' ) ); +__PACKAGE__->meta->add_attribute( 'does' => ( reader => '_does_metadata' ) ); +__PACKAGE__->meta->add_attribute( 'is' => ( reader => '_is_metadata' ) ); + +__PACKAGE__->meta->add_attribute( 'required' => ( reader => 'is_required' ) ); +__PACKAGE__->meta->add_attribute( 'lazy' => ( reader => 'is_lazy' ) ); +__PACKAGE__->meta->add_attribute( + 'lazy_build' => ( reader => 'is_lazy_build' ) ); +__PACKAGE__->meta->add_attribute( 'coerce' => ( reader => 'should_coerce' ) ); +__PACKAGE__->meta->add_attribute( 'weak_ref' => ( reader => 'is_weak_ref' ) ); +__PACKAGE__->meta->add_attribute( + 'auto_deref' => ( reader => 'should_auto_deref' ) ); +__PACKAGE__->meta->add_attribute( + 'type_constraint' => ( + reader => 'type_constraint', + predicate => 'has_type_constraint', + ) +); +__PACKAGE__->meta->add_attribute( + 'trigger' => ( + reader => 'trigger', + predicate => 'has_trigger', + ) +); +__PACKAGE__->meta->add_attribute( + 'handles' => ( + reader => 'handles', + writer => '_set_handles', + predicate => 'has_handles', + ) +); +__PACKAGE__->meta->add_attribute( + 'documentation' => ( + reader => 'documentation', + predicate => 'has_documentation', + ) +); + +1; + +__END__ + +=pod + +=head1 NAME + +Moose::Meta::Mixin::AttributeCore - Core attributes shared by attribute metaclasses + +=head1 DESCRIPTION + +This class implements the core attributes (aka properties) shared by all Moose +attributes. See the L documentation for API details. + +=head1 AUTHORS + +Dave Rolsky Eautarch@urth.orgE + +=head1 COPYRIGHT AND LICENSE + +Copyright 2006-2009 by Infinity Interactive, Inc. + +L + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut diff --git a/lib/Moose/Meta/Role.pm b/lib/Moose/Meta/Role.pm index e387a05..1ff73a3 100644 --- a/lib/Moose/Meta/Role.pm +++ b/lib/Moose/Meta/Role.pm @@ -14,11 +14,13 @@ $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; use Moose::Meta::Class; +use Moose::Meta::Role::Attribute; use Moose::Meta::Role::Method; use Moose::Meta::Role::Method::Required; use Moose::Meta::Role::Method::Conflicting; +use Moose::Util qw( ensure_all_roles ); -use base 'Class::MOP::Module'; +use base 'Class::MOP::Module', 'Class::MOP::Mixin::HasAttributes'; ## ------------------------------------------------------------------ ## NOTE: @@ -70,16 +72,6 @@ foreach my $action ( existence => 'requires_method', } }, - { - name => '_attribute_map', - attr_reader => '_attribute_map', - methods => { - get => 'get_attribute', - get_keys => 'get_attribute_list', - existence => 'has_attribute', - remove => 'remove_attribute', - } - } ) { my $attr_reader = $action->{attr_reader}; @@ -159,23 +151,60 @@ $META->add_attribute( default => 'Moose::Meta::Role::Application::ToInstance', ); -## some things don't always fit, so they go here ... +# More or less copied from Moose::Meta::Class +sub initialize { + my $class = shift; + my $pkg = shift; + return Class::MOP::get_metaclass_by_name($pkg) + || $class->SUPER::initialize( + $pkg, + 'attribute_metaclass' => 'Moose::Meta::Role::Attribute', + @_ + ); +} -sub add_attribute { +sub reinitialize { my $self = shift; - my $name = shift; - unless ( defined $name ) { - require Moose; - Moose->throw_error("You must provide a name for the attribute"); + my $pkg = shift; + + my $meta = blessed $pkg ? $pkg : Class::MOP::class_of($pkg); + + my %existing_classes; + if ($meta) { + %existing_classes = map { $_ => $meta->$_() } qw( + attribute_metaclass + method_metaclass + wrapped_method_metaclass + required_method_metaclass + conflicting_method_metaclass + application_to_class_class + application_to_role_class + application_to_instance_class + ); } - my $attr_desc; - if (scalar @_ == 1 && ref($_[0]) eq 'HASH') { - $attr_desc = $_[0]; - } - else { - $attr_desc = { @_ }; + + return $self->SUPER::reinitialize( + $pkg, + %existing_classes, + @_, + ); +} + +sub add_attribute { + my $self = shift; + + if (blessed $_[0] && ! $_[0]->isa('Moose::Meta::Role::Attribute') ) { + my $class = ref $_[0]; + Moose->throw_error( "Cannot add a $class as an attribute to a role" ); } - $self->_attribute_map->{$name} = $attr_desc; + + return $self->SUPER::add_attribute(@_); +} + +sub _attach_attribute { + my ( $self, $attribute ) = @_; + + $attribute->attach_to_role($self); } sub add_required_methods { @@ -451,7 +480,8 @@ sub create { if (exists $options{attributes}) { foreach my $attribute_name (keys %{$options{attributes}}) { my $attr = $options{attributes}->{$attribute_name}; - $meta->add_attribute($attribute_name => $attr); + $meta->add_attribute( + $attribute_name => blessed $attr ? $attr : %{$attr} ); } } @@ -560,20 +590,6 @@ sub create { # } # ); # -# has 'attribute_map' => ( -# metaclass => 'Hash', -# reader => '_attribute_map', -# isa => 'HashRef[Str]', -# provides => { -# # 'set' => 'add_attribute' # has some special crap in it -# 'get' => 'get_attribute', -# 'keys' => 'get_attribute_list', -# 'exists' => 'has_attribute', -# # Not exactly delete, cause it sets multiple -# 'delete' => 'remove_attribute', -# } -# ); -# # has 'required_methods' => ( # metaclass => 'Hash', # reader => 'get_required_methods_map', diff --git a/lib/Moose/Meta/Role/Application/RoleSummation.pm b/lib/Moose/Meta/Role/Application/RoleSummation.pm index 8532276..8619c19 100644 --- a/lib/Moose/Meta/Role/Application/RoleSummation.pm +++ b/lib/Moose/Meta/Role/Application/RoleSummation.pm @@ -116,30 +116,36 @@ sub check_required_attributes { sub apply_attributes { my ($self, $c) = @_; - my @all_attributes = map { - my $role = $_; - map { - +{ - name => $_, - attr => $role->get_attribute($_), - } - } $role->get_attribute_list - } @{$c->get_roles}; + my @all_attributes; + + for my $role ( @{ $c->get_roles } ) { + push @all_attributes, + map { $role->get_attribute($_) } $role->get_attribute_list; + } my %seen; foreach my $attr (@all_attributes) { - if (exists $seen{$attr->{name}}) { - if ( $seen{$attr->{name}} != $attr->{attr} ) { - require Moose; - Moose->throw_error("We have encountered an attribute conflict with '" . $attr->{name} . "' " - . "during composition. This is fatal error and cannot be disambiguated.") - } + my $name = $attr->name; + + if ( exists $seen{$name} ) { + next if $seen{$name}->is_same_as($attr); + + my $role1 = $seen{$name}->associated_role->name; + my $role2 = $attr->associated_role->name; + + require Moose; + Moose->throw_error( + "We have encountered an attribute conflict with '$name' " + . "during role composition. " + . " This attribute is defined in both $role1 and $role2." + . " This is fatal error and cannot be disambiguated." ); } - $seen{$attr->{name}} = $attr->{attr}; + + $seen{$name} = $attr; } foreach my $attr (@all_attributes) { - $c->add_attribute($attr->{name}, $attr->{attr}); + $c->add_attribute( $attr->clone ); } } diff --git a/lib/Moose/Meta/Role/Application/ToClass.pm b/lib/Moose/Meta/Role/Application/ToClass.pm index f9f5239..ed7ea6b 100644 --- a/lib/Moose/Meta/Role/Application/ToClass.pm +++ b/lib/Moose/Meta/Role/Application/ToClass.pm @@ -129,6 +129,8 @@ sub check_required_attributes { sub apply_attributes { my ($self, $role, $class) = @_; + my $attr_metaclass = $class->attribute_metaclass; + foreach my $attribute_name ($role->get_attribute_list) { # it if it has one already if ($class->has_attribute($attribute_name) && @@ -138,8 +140,7 @@ sub apply_attributes { } else { $class->add_attribute( - $attribute_name, - $role->get_attribute($attribute_name) + $role->get_attribute($attribute_name)->attribute_for_class($attr_metaclass) ); } } diff --git a/lib/Moose/Meta/Role/Application/ToInstance.pm b/lib/Moose/Meta/Role/Application/ToInstance.pm index 184ca89..a0c85cf 100644 --- a/lib/Moose/Meta/Role/Application/ToInstance.pm +++ b/lib/Moose/Meta/Role/Application/ToInstance.pm @@ -30,6 +30,14 @@ sub apply { } else { my $obj_meta = Class::MOP::class_of($object) || 'Moose::Meta::Class'; + + # This is a special case to handle the case where the object's + # metaclass is a Class::MOP::Class, but _not_ a Moose::Meta::Class + # (for example, when applying a role to a Moose::Meta::Attribute + # object). + $obj_meta = 'Moose::Meta::Class' + unless $obj_meta->isa('Moose::Meta::Class'); + $class = $obj_meta->create_anon_class( superclasses => [ blessed($object) ] ); diff --git a/lib/Moose/Meta/Role/Application/ToRole.pm b/lib/Moose/Meta/Role/Application/ToRole.pm index 1a752fa..d526d14 100644 --- a/lib/Moose/Meta/Role/Application/ToRole.pm +++ b/lib/Moose/Meta/Role/Application/ToRole.pm @@ -63,8 +63,7 @@ sub apply_attributes { } else { $role2->add_attribute( - $attribute_name, - $role1->get_attribute($attribute_name) + $role1->get_attribute($attribute_name)->clone ); } } diff --git a/lib/Moose/Meta/Role/Attribute.pm b/lib/Moose/Meta/Role/Attribute.pm new file mode 100644 index 0000000..a7c7f96 --- /dev/null +++ b/lib/Moose/Meta/Role/Attribute.pm @@ -0,0 +1,180 @@ +package Moose::Meta::Role::Attribute; + +use strict; +use warnings; + +use Carp 'confess'; +use List::MoreUtils 'all'; +use Scalar::Util 'blessed', 'weaken'; + +our $VERSION = '0.93'; +our $AUTHORITY = 'cpan:STEVAN'; + +use base 'Moose::Meta::Mixin::AttributeCore'; + +__PACKAGE__->meta->add_attribute( + 'metaclass' => ( + reader => 'metaclass', + ) +); + +__PACKAGE__->meta->add_attribute( + 'associated_role' => ( + reader => 'associated_role', + ) +); + +__PACKAGE__->meta->add_attribute( + 'is' => ( + reader => 'is', + ) +); + +__PACKAGE__->meta->add_attribute( + 'original_options' => ( + reader => 'original_options', + ) +); + +sub new { + my ( $class, $name, %options ) = @_; + + (defined $name) + || confess "You must provide a name for the attribute"; + + return bless { + name => $name, + original_options => \%options, + %options, + }, $class; +} + +sub attach_to_role { + my ( $self, $role ) = @_; + + ( blessed($role) && $role->isa('Moose::Meta::Role') ) + || confess + "You must pass a Moose::Meta::Role instance (or a subclass)"; + + weaken( $self->{'associated_role'} = $role ); +} + +sub attribute_for_class { + my $self = shift; + my $metaclass = shift; + + return $metaclass->interpolate_class_and_new( + $self->name => %{ $self->original_options } ); +} + +sub clone { + my $self = shift; + + return ( ref $self )->new( $self->name, %{ $self->original_options } ); +} + +sub is_same_as { + my $self = shift; + my $attr = shift; + + my $self_options = $self->original_options; + my $other_options = $attr->original_options; + + return 0 + unless ( join q{|}, sort keys %{$self_options} ) eq ( join q{|}, sort keys %{$other_options} ); + + for my $key ( keys %{$self_options} ) { + return 0 if defined $self_options->{$key} && ! defined $other_options->{$key}; + return 0 if ! defined $self_options->{$key} && defined $other_options->{$key}; + + next if all { ! defined } $self_options->{$key}, $other_options->{$key}; + + return 0 unless $self_options->{$key} eq $other_options->{$key}; + } + + return 1; +} + +1; + +=pod + +=head1 NAME + +Moose::Meta::Role::Attribute - A Moose Attribute metaclass for Roles + +=head1 DESCRIPTION + +This class implements the API for attributes in roles. Attributes in roles are +more like attribute prototypes than full blown attributes. While they are +introspectable, they have very little behavior. + +=head1 METHODS + +This class provides the following methods: + +=over 4 + +=item B<< Moose::Meta::Role::Attribute->new(...) >> + +This method accepts all the options that would be passed to the constructor +for L. + +=item B<< $attr->metaclass >> + +=item B<< $attr->is >> + +Returns the option as passed to the constructor. + +=item B<< $attr->associated_role >> + +Returns the L to which this attribute belongs, if any. + +=item B<< $attr->original_options >> + +Returns a hash reference of options passed to the constructor. This is used +when creating a L object from this object. + +=item B<< $attr->attach_to_role($role) >> + +Attaches the attribute to the given L. + +=item B<< $attr->attribute_for_class($metaclass) >> + +Given an attribute metaclass name, this method calls C<< +$metaclass->interpolate_class_and_new >> to construct an attribute object +which can be added to a L. + +=item B<< $attr->clone >> + +Creates a new object identical to the object on which the method is called. + +=item B<< $attr->is_same_as($other_attr) >> + +Compares two role attributes and returns true if they are identical. + +=back + +In addition, this class implements all informational predicates implements by +L (and L). + +=head1 BUGS + +All complex software has bugs lurking in it, and this module is no +exception. If you find a bug please either email me, or add the bug +to cpan-RT. + +=head1 AUTHOR + +Dave Rolsky Eautarch@urth.orgE + +=head1 COPYRIGHT AND LICENSE + +Copyright 2006-2009 by Infinity Interactive, Inc. + +L + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut diff --git a/lib/Moose/Meta/Role/Composite.pm b/lib/Moose/Meta/Role/Composite.pm index 522fc5b..0fc8f32 100644 --- a/lib/Moose/Meta/Role/Composite.pm +++ b/lib/Moose/Meta/Role/Composite.pm @@ -125,10 +125,19 @@ sub apply_params { } sub reinitialize { - my ($class, $old_meta, @args) = @_; - Moose->throw_error('Moose::Meta::Role::Composite instances can only be reinitialized from an existing metaclass instance') - if !blessed $old_meta || !$old_meta->isa('Moose::Meta::Role::Composite'); - return $old_meta->meta->clone_object($old_meta, @args); + my ( $class, $old_meta, @args ) = @_; + + Moose->throw_error( + 'Moose::Meta::Role::Composite instances can only be reinitialized from an existing metaclass instance' + ) + if !blessed $old_meta + || !$old_meta->isa('Moose::Meta::Role::Composite'); + + my %existing_classes = map { $_ => $old_meta->$_() } qw( + application_role_summation_class + ); + + return $old_meta->meta->clone_object( $old_meta, %existing_classes, @args ); } 1; diff --git a/lib/Moose/Util/MetaRole.pm b/lib/Moose/Util/MetaRole.pm index e0bbe0e..9e8d71b 100644 --- a/lib/Moose/Util/MetaRole.pm +++ b/lib/Moose/Util/MetaRole.pm @@ -9,89 +9,124 @@ $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; use List::MoreUtils qw( all ); - -my @Classes = qw( constructor_class destructor_class error_class ); +use List::Util qw( first ); sub apply_metaclass_roles { - my %options = @_; - - my $for = blessed $options{for_class} - ? $options{for_class} - : Class::MOP::class_of($options{for_class}); - - my %old_classes = map { $_ => $for->$_ } - grep { $for->can($_) } - @Classes; - - my $meta = _make_new_metaclass( $for, \%options ); - - for my $c ( grep { $meta->can($_) } @Classes ) { - if ( $options{ $c . '_roles' } ) { - my $class = _make_new_class( - $meta->$c(), - $options{ $c . '_roles' } - ); - - $meta->$c($class); - } - else { - $meta->$c( $old_classes{$c} ); - } + goto &apply_metaroles; +} + +sub apply_metaroles { + my %args = @_; + + _fixup_old_style_args(\%args); + Carp::cluck('applying') if $::D; + my $for + = blessed $args{for} + ? $args{for} + : Class::MOP::class_of( $args{for} ); + + if ( $for->isa('Moose::Meta::Role') ) { + return _make_new_metaclass( $for, $args{role_metaroles}, 'role' ); + } + else { + return _make_new_metaclass( $for, $args{class_metaroles}, 'class' ); } +} + +sub _fixup_old_style_args { + my $args = shift; + + return if $args->{class_metaroles} || $args->{roles_metaroles}; + + $args->{for} = delete $args->{for_class} + if exists $args->{for_class}; + + my @old_keys = qw( + attribute_metaclass_roles + method_metaclass_roles + wrapped_method_metaclass_roles + instance_metaclass_roles + constructor_class_roles + destructor_class_roles + error_class_roles + + application_to_class_class_roles + application_to_role_class_roles + application_to_instance_class_roles + application_role_summation_class_roles + ); - return $meta; + my $for + = blessed $args->{for} + ? $args->{for} + : Class::MOP::class_of( $args->{for} ); + + my $top_key; + if ( $for->isa('Moose::Meta::Class') ) { + $top_key = 'class_metaroles'; + + $args->{class_metaroles}{class} = delete $args->{metaclass_roles} + if exists $args->{metaclass_roles}; + } + else { + $top_key = 'role_metaroles'; + + $args->{role_metaroles}{role} = delete $args->{metaclass_roles} + if exists $args->{metaclass_roles}; + } + + for my $old_key (@old_keys) { + my ($new_key) = $old_key =~ /^(.+)_(?:class|metaclass)_roles$/; + + $args->{$top_key}{$new_key} = delete $args->{$old_key} + if exists $args->{$old_key}; + } + + return; } sub _make_new_metaclass { my $for = shift; - my $options = shift; - - return $for - unless grep { exists $options->{ $_ . '_roles' } } - qw( - metaclass - attribute_metaclass - method_metaclass - wrapped_method_metaclass - instance_metaclass - application_to_class_class - application_to_role_class - application_to_instance_class - application_role_summation_class - ); + my $roles = shift; + my $primary = shift; + + return $for unless keys %{$roles}; my $new_metaclass - = _make_new_class( ref $for, $options->{metaclass_roles} ); - - # This could get called for a Moose::Meta::Role as well as a Moose::Meta::Class - my %classes = map { - $_ => _make_new_class( $for->$_(), $options->{ $_ . '_roles' } ) - } - grep { $for->can($_) } - qw( - attribute_metaclass - method_metaclass - wrapped_method_metaclass - instance_metaclass - application_to_class_class - application_to_role_class - application_to_instance_class - application_role_summation_class - ); + = exists $roles->{$primary} + ? _make_new_class( ref $for, $roles->{$primary} ) + : blessed $for; - return $new_metaclass->reinitialize( $for, %classes ); + my %classes; + + for my $key ( grep { $_ ne $primary } keys %{$roles} ) { + my $attr = first {$_} + map { $for->meta->find_attribute_by_name($_) } ( + $key . '_metaclass', + $key . '_class' + ); + + my $reader = $attr->get_read_method; + + $classes{ $attr->init_arg } + = _make_new_class( $for->$reader(), $roles->{$key} ); + } + + my $new_meta = $new_metaclass->reinitialize( $for, %classes ); + + return $new_meta; } sub apply_base_class_roles { - my %options = @_; + my %args = @_; - my $for = $options{for_class}; + my $for = $args{for} || $args{for_class}; my $meta = Class::MOP::class_of($for); my $new_base = _make_new_class( $for, - $options{roles}, + $args{roles}, [ $meta->superclasses() ], ); @@ -143,22 +178,24 @@ Moose::Util::MetaRole - Apply roles to any metaclass, as well as the object base sub init_meta { shift; - my %options = @_; + my %args = @_; - Moose->init_meta(%options); + Moose->init_meta(%args); - Moose::Util::MetaRole::apply_metaclass_roles( - for_class => $options{for_class}, - metaclass_roles => ['MyApp::Role::Meta::Class'], - constructor_class_roles => ['MyApp::Role::Meta::Method::Constructor'], + Moose::Util::MetaRole::apply_metaroles( + for => $args{for_class}, + class_metaroles => { + class => => ['MyApp::Role::Meta::Class'], + constructor => ['MyApp::Role::Meta::Method::Constructor'], + }, ); Moose::Util::MetaRole::apply_base_class_roles( - for_class => $options{for_class}, - roles => ['MyApp::Role::Object'], + for => $args{for_class}, + roles => ['MyApp::Role::Object'], ); - return $options{for_class}->meta(); + return $args{for_class}->meta(); } =head1 DESCRIPTION @@ -189,44 +226,80 @@ method for you, and make sure it is called when imported. This module provides two functions. -=head2 apply_metaclass_roles( ... ) +=head2 apply_metaroles( ... ) This function will apply roles to one or more metaclasses for the specified class. It accepts the following parameters: =over 4 -=item * for_class => $name +=item * for => $name + +This specifies the class or for which to alter the meta classes. This can be a +package name, or an appropriate meta-object (a L or +L). -This specifies the class for which to alter the meta classes. +=item * class_metaroles => \%roles -=item * metaclass_roles => \@roles +This is a hash reference specifying which metaroles will be applied to the +class metaclass and its contained metaclasses and helper classes. -=item * attribute_metaclass_roles => \@roles +Each key should in turn point to an array reference of role names. -=item * method_metaclass_roles => \@roles +It accepts the following keys: -=item * wrapped_method_metaclass_roles => \@roles +=over 8 -=item * instance_metaclass_roles => \@roles +=item class -=item * constructor_class_roles => \@roles +=item attribute -=item * destructor_class_roles => \@roles +=item method -=item * application_to_class_class_roles => \@roles +=item wrapped_method + +=item instance + +=item constructor + +=item destructor + +=item error + +=back -=item * application_to_role_class_roles => \@roles +=item * role_metaroles => \%roles -=item * application_to_instance_class_roles => \@roles +This is a hash reference specifying which metaroles will be applied to the +role metaclass and its contained metaclasses and helper classes. -These parameter all specify one or more roles to be applied to the -specified metaclass. You can pass any or all of these parameters at -once. +It accepts the following keys: + +=over 8 + +=item role + +=item attribute + +=item method + +=item required_method + +=item conflicting_method + +=item application_to_class + +=item application_to_role + +=item application_to_instance + +=item application_role_summation + +=back =back -=head2 apply_base_class_roles( for_class => $class, roles => \@roles ) +=head2 apply_base_class_roles( for => $class, roles => \@roles ) This function will apply the specified roles to the object's base class. diff --git a/t/020_attributes/005_attribute_does.t b/t/020_attributes/005_attribute_does.t index 6d00c67..945717b 100644 --- a/t/020_attributes/005_attribute_does.t +++ b/t/020_attributes/005_attribute_does.t @@ -21,6 +21,11 @@ use Test::Exception; does => role_type('Bar::Role') ); + package Foo::Class; + use Moose; + + with 'Foo::Role'; + package Bar::Role; use Moose::Role; @@ -29,16 +34,10 @@ use Test::Exception; # since the isa() check will imply the does() check has 'foo' => (is => 'rw', isa => 'Foo::Class', does => 'Foo::Role'); - package Foo::Class; - use Moose; - - with 'Foo::Role'; - package Bar::Class; use Moose; with 'Bar::Role'; - } my $foo = Foo::Class->new; diff --git a/t/020_attributes/028_no_slot_access.t b/t/020_attributes/028_no_slot_access.t index 7587bbb..d9a5eca 100644 --- a/t/020_attributes/028_no_slot_access.t +++ b/t/020_attributes/028_no_slot_access.t @@ -63,9 +63,9 @@ use warnings; use Test::More; use Test::Exception; - Moose::Util::MetaRole::apply_metaclass_roles( - for_class => __PACKAGE__, - instance_metaclass_roles => ['MooseX::SomeAwesomeDBFields'] + Moose::Util::MetaRole::apply_metaroles( + for => __PACKAGE__, + class_metaroles => { instance => ['MooseX::SomeAwesomeDBFields'] }, ); lives_ok { diff --git a/t/030_roles/001_meta_role.t b/t/030_roles/001_meta_role.t index 309f4b1..2a040f3 100644 --- a/t/030_roles/001_meta_role.t +++ b/t/030_roles/001_meta_role.t @@ -7,6 +7,7 @@ use Test::More; use Test::Exception; use Moose::Meta::Role; +use Moose::Util::TypeConstraints (); { package FooRole; @@ -55,10 +56,15 @@ is_deeply( ok($foo_role->has_attribute('bar'), '... FooRole does have the bar attribute'); -is_deeply( - $foo_role->get_attribute('bar'), - { is => 'rw', isa => 'Foo' }, - '... got the correct description of the bar attribute'); +my $bar = $foo_role->get_attribute('bar'); +is_deeply( $bar->original_options, { is => 'rw', isa => 'Foo' }, + 'original options for bar attribute' ); +my $bar_for_class = $bar->attribute_for_class('Moose::Meta::Attribute'); +is( + $bar_for_class->type_constraint, + Moose::Util::TypeConstraints::class_type('Foo'), + 'bar has a Foo class type' +); lives_ok { $foo_role->add_attribute('baz' => (is => 'ro')); @@ -71,10 +77,9 @@ is_deeply( ok($foo_role->has_attribute('baz'), '... FooRole does have the baz attribute'); -is_deeply( - $foo_role->get_attribute('baz'), - { is => 'ro' }, - '... got the correct description of the baz attribute'); +my $baz = $foo_role->get_attribute('baz'); +is_deeply( $baz->original_options, { is => 'ro' }, + 'original options for baz attribute' ); lives_ok { $foo_role->remove_attribute('bar'); diff --git a/t/030_roles/044_role_attrs.t b/t/030_roles/044_role_attrs.t new file mode 100644 index 0000000..5bdd14c --- /dev/null +++ b/t/030_roles/044_role_attrs.t @@ -0,0 +1,54 @@ +use strict; +use warnings; + +use Test::More; +use Test::Exception; + +use Moose (); +use Moose::Meta::Role; +use Moose::Util; + +my $role1 = Moose::Meta::Role->initialize('Foo'); +$role1->add_attribute( foo => ( is => 'ro' ) ); + +ok( $role1->has_attribute('foo'), 'Foo role has a foo attribute' ); + +my $foo_attr = $role1->get_attribute('foo'); +is( + $foo_attr->associated_role->name, 'Foo', + 'associated_role for foo attr is Foo role' +); + +isa_ok( + $foo_attr->attribute_for_class('Moose::Meta::Attribute'), + 'Moose::Meta::Attribute', + 'attribute returned by ->attribute_for_class' +); + +my $role2 = Moose::Meta::Role->initialize('Bar'); +$role1->apply($role2); + +ok( $role2->has_attribute('foo'), 'Bar role has a foo attribute' ); + +is( + $foo_attr->associated_role->name, 'Foo', + 'associated_role for foo attr is still Foo role' +); + +isa_ok( + $foo_attr->attribute_for_class('Moose::Meta::Attribute'), + 'Moose::Meta::Attribute', + 'attribute returned by ->attribute_for_class' +); + +my $role3 = Moose::Meta::Role->initialize('Baz'); +my $combined = Moose::Meta::Role->combine( [ $role1->name ], [ $role3->name ] ); + +ok( $combined->has_attribute('foo'), 'combined role has a foo attribute' ); + +is( + $foo_attr->associated_role->name, 'Foo', + 'associated_role for foo attr is still Foo role' +); + +done_testing; diff --git a/t/050_metaclasses/015_metarole.t b/t/050_metaclasses/015_metarole.t index 2020949..99931d8 100644 --- a/t/050_metaclasses/015_metarole.t +++ b/t/050_metaclasses/015_metarole.t @@ -35,9 +35,9 @@ use Moose::Util::MetaRole; } { - Moose::Util::MetaRole::apply_metaclass_roles( - for_class => My::Class->meta, - metaclass_roles => ['Role::Foo'], + Moose::Util::MetaRole::apply_metaroles( + for => My::Class->meta, + class_metaroles => { class => ['Role::Foo'] }, ); ok( My::Class->meta()->meta()->does_role('Role::Foo'), @@ -47,9 +47,9 @@ use Moose::Util::MetaRole; } { - Moose::Util::MetaRole::apply_metaclass_roles( - for_class => 'My::Class', - attribute_metaclass_roles => ['Role::Foo'], + Moose::Util::MetaRole::apply_metaroles( + for => 'My::Class', + class_metaroles => { attribute => ['Role::Foo'] }, ); ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'), @@ -63,9 +63,9 @@ use Moose::Util::MetaRole; } { - Moose::Util::MetaRole::apply_metaclass_roles( - for_class => 'My::Class', - method_metaclass_roles => ['Role::Foo'], + Moose::Util::MetaRole::apply_metaroles( + for => 'My::Class', + class_metaroles => { method => ['Role::Foo'] }, ); ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'), @@ -81,9 +81,9 @@ use Moose::Util::MetaRole; } { - Moose::Util::MetaRole::apply_metaclass_roles( - for_class => 'My::Class', - wrapped_method_metaclass_roles => ['Role::Foo'], + 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'), @@ -101,9 +101,9 @@ use Moose::Util::MetaRole; } { - Moose::Util::MetaRole::apply_metaclass_roles( - for_class => 'My::Class', - instance_metaclass_roles => ['Role::Foo'], + Moose::Util::MetaRole::apply_metaroles( + for => 'My::Class', + class_metaroles => { instance => ['Role::Foo'] }, ); ok( My::Class->meta()->instance_metaclass()->meta()->does_role('Role::Foo'), @@ -120,9 +120,9 @@ use Moose::Util::MetaRole; } { - Moose::Util::MetaRole::apply_metaclass_roles( - for_class => 'My::Class', - constructor_class_roles => ['Role::Foo'], + Moose::Util::MetaRole::apply_metaroles( + for => 'My::Class', + class_metaroles => { constructor => ['Role::Foo'] }, ); ok( My::Class->meta()->constructor_class()->meta()->does_role('Role::Foo'), @@ -142,9 +142,9 @@ use Moose::Util::MetaRole; } { - Moose::Util::MetaRole::apply_metaclass_roles( - for_class => 'My::Class', - destructor_class_roles => ['Role::Foo'], + Moose::Util::MetaRole::apply_metaroles( + for => 'My::Class', + class_metaroles => { destructor => ['Role::Foo'] }, ); ok( My::Class->meta()->destructor_class()->meta()->does_role('Role::Foo'), @@ -166,9 +166,9 @@ use Moose::Util::MetaRole; } { - Moose::Util::MetaRole::apply_metaclass_roles( - for_class => 'My::Role', - application_to_class_class_roles => ['Role::Foo'], + 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'), @@ -179,9 +179,9 @@ use Moose::Util::MetaRole; } { - Moose::Util::MetaRole::apply_metaclass_roles( - for_class => 'My::Role', - application_to_role_class_roles => ['Role::Foo'], + 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'), @@ -194,9 +194,9 @@ use Moose::Util::MetaRole; } { - Moose::Util::MetaRole::apply_metaclass_roles( - for_class => 'My::Role', - application_to_instance_class_roles => ['Role::Foo'], + 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'), @@ -212,8 +212,8 @@ use Moose::Util::MetaRole; { Moose::Util::MetaRole::apply_base_class_roles( - for_class => 'My::Class', - roles => ['Role::Foo'], + for => 'My::Class', + roles => ['Role::Foo'], ); ok( My::Class->meta()->does_role('Role::Foo'), @@ -229,14 +229,16 @@ use Moose::Util::MetaRole; } { - Moose::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'], + 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'), @@ -296,9 +298,9 @@ use Moose::Util::MetaRole; { - Moose::Util::MetaRole::apply_metaclass_roles( - for_class => 'My::Class3', - metaclass_roles => ['Role::Foo'], + Moose::Util::MetaRole::apply_metaroles( + for => 'My::Class3', + class_metaroles => { class => ['Role::Foo'] }, ); ok( My::Class3->meta()->meta()->does_role('Role::Foo'), @@ -306,7 +308,7 @@ use Moose::Util::MetaRole; 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 Moose->init_meta()' ); + 'apply_metaroles() does not interfere with metaclass set via Moose->init_meta()' ); } { @@ -321,17 +323,17 @@ use Moose::Util::MetaRole; } { - Moose::Util::MetaRole::apply_metaclass_roles( - for_class => 'My::Class4', - metaclass_roles => ['Role::Foo'], + 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_metaclass_roles( - for_class => 'My::Class4', - metaclass_roles => ['Role::Bar'], + Moose::Util::MetaRole::apply_metaroles( + for => 'My::Class4', + class_metaroles => { class => ['Role::Bar'] }, ); ok( My::Class4->meta()->meta()->does_role('Role::Bar'), @@ -363,9 +365,9 @@ use Moose::Util::MetaRole; } { - Moose::Util::MetaRole::apply_metaclass_roles( - for_class => 'My::Class5', - metaclass_roles => ['Role::Bar'], + Moose::Util::MetaRole::apply_metaroles( + for => 'My::Class5', + class_metaroles => { class => ['Role::Bar'] }, ); ok( My::Class5->meta()->meta()->does_role('Role::Bar'), @@ -378,9 +380,9 @@ use Moose::Util::MetaRole; package My::Class6; use Moose; - Moose::Util::MetaRole::apply_metaclass_roles( - for_class => 'My::Class6', - metaclass_roles => ['Role::Bar'], + Moose::Util::MetaRole::apply_metaroles( + for => 'My::Class6', + class_metaroles => { class => ['Role::Bar'] }, ); extends 'My::Class'; @@ -403,12 +405,12 @@ use Moose::Util::MetaRole; use Moose; # In real usage this would go in a BEGIN block so it happened - # before apply_metaclass_roles was called by an extension. + # before apply_metaroles was called by an extension. extends 'My::Class'; - Moose::Util::MetaRole::apply_metaclass_roles( - for_class => 'My::Class7', - metaclass_roles => ['Role::Bar'], + Moose::Util::MetaRole::apply_metaroles( + for => 'My::Class7', + class_metaroles => { class => ['Role::Bar'] }, ); } @@ -423,10 +425,12 @@ use Moose::Util::MetaRole; package My::Class8; use Moose; - Moose::Util::MetaRole::apply_metaclass_roles( - for_class => 'My::Class8', - metaclass_roles => ['Role::Bar'], - attribute_metaclass_roles => ['Role::Bar'], + Moose::Util::MetaRole::apply_metaroles( + for => 'My::Class8', + class_metaroles => { + class => ['Role::Bar'], + attribute => ['Role::Bar'], + }, ); extends 'My::Class'; @@ -448,9 +452,9 @@ use Moose::Util::MetaRole; package My::Class9; use Moose; - Moose::Util::MetaRole::apply_metaclass_roles( - for_class => 'My::Class9', - attribute_metaclass_roles => ['Role::Bar'], + Moose::Util::MetaRole::apply_metaroles( + for => 'My::Class9', + class_metaroles => { attribute => ['Role::Bar'] }, ); extends 'My::Class'; @@ -479,9 +483,9 @@ use Moose::Util::MetaRole; use Moose; extends 'Moose::Meta::Class'; - Moose::Util::MetaRole::apply_metaclass_roles( - for_class => 'My::Meta::Class2', - metaclass_roles => ['Role::Foo'], + Moose::Util::MetaRole::apply_metaroles( + for => 'My::Meta::Class2', + class_metaroles => { class => ['Role::Foo'] }, ); } @@ -513,9 +517,9 @@ use Moose::Util::MetaRole; package My::Class10; My::Meta2->import; - Moose::Util::MetaRole::apply_metaclass_roles( - for_class => 'My::Class10', - metaclass_roles => ['Role::Bar'], + Moose::Util::MetaRole::apply_metaroles( + for => 'My::Class10', + class_metaroles => { class => ['Role::Bar'] }, ); } @@ -543,9 +547,9 @@ use Moose::Util::MetaRole; __PACKAGE__->meta->constructor_class('My::Constructor'); - Moose::Util::MetaRole::apply_metaclass_roles( - for_class => 'My::Class11', - metaclass_roles => ['Role::Foo'], + Moose::Util::MetaRole::apply_metaroles( + for => 'My::Class11', + class_metaroles => { class => ['Role::Foo'] }, ); } @@ -560,14 +564,14 @@ use Moose::Util::MetaRole; package ExportsMoose; Moose::Exporter->setup_import_methods( - also => 'Moose', + also => 'Moose', ); sub init_meta { shift; my %p = @_; Moose->init_meta(%p); - return Moose::Util::MetaRole::apply_metaclass_roles( + 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. @@ -586,23 +590,27 @@ lives_ok { use Moose::Role; } + { package Foo::Role; Moose::Exporter->setup_import_methods( - also => 'Moose::Role', + also => 'Moose::Role', ); sub init_meta { shift; my %p = @_; + Moose::Role->init_meta(%p); - return Moose::Util::MetaRole::apply_metaclass_roles( - for_class => $p{for_class}, - method_metaclass_roles => [ 'Foo::Meta::Role', ], + + return Moose::Util::MetaRole::apply_metaroles( + for => $p{for_class}, + role_metaroles => { method => ['Foo::Meta::Role'] }, ); } } + { package Role::Baz; @@ -610,6 +618,7 @@ lives_ok { sub bla {} } + { package My::Class12; @@ -617,11 +626,13 @@ lives_ok { 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' ), @@ -633,9 +644,9 @@ lives_ok { package Parent; use Moose; - Moose::Util::MetaRole::apply_metaclass_roles( - for_class => __PACKAGE__, - constructor_class_roles => ['Role::Foo'], + Moose::Util::MetaRole::apply_metaroles( + for => __PACKAGE__, + class_metaroles => { constructor => ['Role::Foo'] }, ); } diff --git a/t/050_metaclasses/016_metarole_w_metaclass_pm.t b/t/050_metaclasses/016_metarole_w_metaclass_pm.t index 8a77dbd..d416c3c 100644 --- a/t/050_metaclasses/016_metarole_w_metaclass_pm.t +++ b/t/050_metaclasses/016_metarole_w_metaclass_pm.t @@ -62,23 +62,25 @@ BEGIN } { - Moose::Util::MetaRole::apply_metaclass_roles( - for_class => 'My::Class', - metaclass_roles => ['Role::Foo'], + Moose::Util::MetaRole::apply_metaroles( + for => 'My::Class', + class_metaroles => { class => ['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' ); + 'apply_metaroles works with metaclass.pm' ); } { - Moose::Util::MetaRole::apply_metaclass_roles( - for_class => 'My::Class2', - attribute_metaclass_roles => ['Role::Foo'], - method_metaclass_roles => ['Role::Foo'], - instance_metaclass_roles => ['Role::Foo'], + Moose::Util::MetaRole::apply_metaroles( + for => 'My::Class2', + class_metaroles => { + attribute => ['Role::Foo'], + method => ['Role::Foo'], + instance => ['Role::Foo'], + }, ); ok( My::Class2->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'), diff --git a/t/050_metaclasses/018_throw_error.t b/t/050_metaclasses/018_throw_error.t index 35df769..8bdf2bc 100644 --- a/t/050_metaclasses/018_throw_error.t +++ b/t/050_metaclasses/018_throw_error.t @@ -102,9 +102,9 @@ sub create_error { use Moose; extends 'Baz'; - Moose::Util::MetaRole::apply_metaclass_roles( - for_class => __PACKAGE__, - metaclass_roles => ['Role::Foo'], + Moose::Util::MetaRole::apply_metaroles( + for => __PACKAGE__, + class_metaroles => { class => ['Role::Foo'] }, ); } @@ -129,9 +129,9 @@ sub create_error { use Moose; - Moose::Util::MetaRole::apply_metaclass_roles( - for_class => __PACKAGE__, - metaclass_roles => ['Role::Foo'], + Moose::Util::MetaRole::apply_metaroles( + for => __PACKAGE__, + class_metaroles => { class => ['Role::Foo'] }, ); } @@ -144,9 +144,9 @@ ok( Foo::Sub->meta->error_class->isa('Moose::Error::Croak'), ::lives_ok { extends 'Foo::Sub' } 'error_class differs by role so incompat is handled'; - Moose::Util::MetaRole::apply_metaclass_roles( - for_class => __PACKAGE__, - error_class_roles => ['Role::Foo'], + Moose::Util::MetaRole::apply_metaroles( + for => __PACKAGE__, + class_metaroles => { error => ['Role::Foo'] }, ); } diff --git a/t/050_metaclasses/023_easy_init_meta.t b/t/050_metaclasses/023_easy_init_meta.t index 148d51e..5f2c28e 100644 --- a/t/050_metaclasses/023_easy_init_meta.t +++ b/t/050_metaclasses/023_easy_init_meta.t @@ -27,6 +27,7 @@ use Test::Moose qw(does_ok); Moose::Exporter->setup_import_methods( metaclass_roles => ['Foo::Trait::Class'], + role_metaclass_roles => ['Foo::Trait::Class'], attribute_metaclass_roles => ['Foo::Trait::Attribute'], base_class_roles => ['Foo::Role::Base'], ); @@ -93,13 +94,14 @@ use Test::Moose qw(does_ok); use Moose::Role (); use Moose::Exporter; - my ($import, $unimport, $init_meta) = - Moose::Exporter->build_import_methods( - also => 'Moose::Role', - metaclass_roles => ['Foo::Trait::Class'], - attribute_metaclass_roles => ['Foo::Trait::Attribute'], - base_class_roles => ['Foo::Role::Base'], - install => [qw(import unimport)], + my ( $import, $unimport, $init_meta ) + = Moose::Exporter->build_import_methods( + also => 'Moose::Role', + role_metaroles => { + role => ['Foo::Trait::Class'], + attribute => ['Foo::Trait::Attribute'], + }, + install => [qw(import unimport)], ); sub init_meta { diff --git a/t/050_metaclasses/030_metarole_combination.t b/t/050_metaclasses/030_metarole_combination.t index c9291bc..899b042 100644 --- a/t/050_metaclasses/030_metarole_combination.t +++ b/t/050_metaclasses/030_metarole_combination.t @@ -81,14 +81,16 @@ our @applications; around apply_params => sub { my ( $next, $self, @args ) = @_; - return Moose::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'], + 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'], + }, ); }; } @@ -111,14 +113,16 @@ our @applications; sub init_meta { my ( $self, %options ) = @_; - return Moose::Util::MetaRole::apply_metaclass_roles( - for_class => Moose::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'], + 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'], + }, ); } } diff --git a/t/050_metaclasses/050_metarole_backcompat.t b/t/050_metaclasses/050_metarole_backcompat.t new file mode 100644 index 0000000..ea325ae --- /dev/null +++ b/t/050_metaclasses/050_metarole_backcompat.t @@ -0,0 +1,672 @@ +#!/usr/bin/perl + +# This is a copy of 015_metarole.t taken on 01/01/2010. It provides a +# comprehensive test of backwards compatibility in the MetaRole API. + +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_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' ); +} + +{ + Moose::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' ); +} + +{ + Moose::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' ); +} + +{ + Moose::Util::MetaRole::apply_metaclass_roles( + for_class => 'My::Class', + wrapped_method_metaclass_roles => ['Role::Foo'], + ); + + ok( My::Class->meta()->wrapped_method_metaclass()->meta()->does_role('Role::Foo'), + q{apply Role::Foo to My::Class->meta()'s wrapped method metaclass} ); + ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'), + '... My::Class->meta() still does Role::Foo' ); + ok( My::Class->meta()->meta()->does_role('Role::Foo'), + '... My::Class->meta() still does Role::Foo' ); + ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'), + q{... My::Class->meta()'s attribute metaclass still does Role::Foo} ); + + My::Class->meta()->add_after_method_modifier( 'bar' => sub { 'bar' } ); + is( My::Class->meta()->get_method('bar')->foo(), 10, + '... call foo() on a wrapped method metaclass object' ); +} + +{ + Moose::Util::MetaRole::apply_metaclass_roles( + for_class => 'My::Class', + instance_metaclass_roles => ['Role::Foo'], + ); + + ok( My::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_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' ); +} + +{ + Moose::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' ); +} + +{ + Moose::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} ); +} + +{ + Moose::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} ); +} + +{ + Moose::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} ); +} + +{ + Moose::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 Moose; +} + +{ + Moose::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 Moose::Exporter; + Moose::Exporter->setup_import_methods( also => 'Moose' ); + + sub init_meta { + shift; + my %p = @_; + + Moose->init_meta( %p, metaclass => 'My::Meta::Class' ); + } +} + +{ + package My::Class3; + + My::Meta->import(); +} + + +{ + Moose::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 Moose->init_meta()' ); +} + +{ + package Role::Bar; + use Moose::Role; + has 'bar' => ( is => 'ro', default => 200 ); +} + +{ + package My::Class4; + use Moose; +} + +{ + Moose::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()' ); + + Moose::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 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_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 Moose; + + Moose::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 Moose; + + # 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'; + + Moose::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 Moose; + + Moose::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 Moose; + + Moose::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 Moose::Meta::Class +# itself, and then it _uses_ MooseX::ClassAttribute, so the metaclass +# for Fey::Meta::Class::Table does a role. +# +# At one point this caused a metaclass incompatibility error down +# below, when we applied roles to the metaclass of My::Class10. It's +# all madness but as long as the tests pass we're happy. +{ + package My::Meta::Class2; + use Moose; + extends 'Moose::Meta::Class'; + + Moose::Util::MetaRole::apply_metaclass_roles( + for_class => 'My::Meta::Class2', + metaclass_roles => ['Role::Foo'], + ); +} + +{ + package My::Object; + use Moose; + extends 'Moose::Object'; +} + +{ + package My::Meta2; + + use Moose::Exporter; + Moose::Exporter->setup_import_methods( also => 'Moose' ); + + sub init_meta { + shift; + my %p = @_; + + Moose->init_meta( + %p, + metaclass => 'My::Meta::Class2', + base_class => 'My::Object', + ); + } +} + +{ + package My::Class10; + My::Meta2->import; + + Moose::Util::MetaRole::apply_metaclass_roles( + for_class => 'My::Class10', + metaclass_roles => ['Role::Bar'], + ); +} + +{ + ok( My::Class10->meta()->meta()->meta()->does_role('Role::Foo'), + q{My::Class10->meta()->meta() does Role::Foo } ); + ok( My::Class10->meta()->meta()->does_role('Role::Bar'), + q{My::Class10->meta()->meta() does Role::Bar } ); + ok( My::Class10->meta()->isa('My::Meta::Class2'), + q{... and My::Class10->meta still isa(My::Meta::Class2)} ); + ok( My::Class10->isa('My::Object'), + q{... and My::Class10 still isa(My::Object)} ); +} + +{ + package My::Constructor; + + use base 'Moose::Meta::Method::Constructor'; +} + +{ + package My::Class11; + + use Moose; + + __PACKAGE__->meta->constructor_class('My::Constructor'); + + Moose::Util::MetaRole::apply_metaclass_roles( + for_class => 'My::Class11', + metaclass_roles => ['Role::Foo'], + ); +} + +{ + ok( My::Class11->meta()->meta()->does_role('Role::Foo'), + q{My::Class11->meta()->meta() does Role::Foo } ); + is( My::Class11->meta()->constructor_class, 'My::Constructor', + q{... and explicitly set constructor_class value is unchanged)} ); +} + +{ + package ExportsMoose; + + Moose::Exporter->setup_import_methods( + also => 'Moose', + ); + + sub init_meta { + shift; + my %p = @_; + Moose->init_meta(%p); + return Moose::Util::MetaRole::apply_metaclass_roles( + for_class => $p{for_class}, + # Causes us to recurse through init_meta, as we have to + # load MyMetaclassRole from disk. + metaclass_roles => [qw/MyMetaclassRole/], + ); + } +} + +lives_ok { + package UsesExportedMoose; + ExportsMoose->import; +} 'import module which loads a role from disk during init_meta'; + +{ + package Foo::Meta::Role; + + use Moose::Role; +} +{ + package Foo::Role; + + Moose::Exporter->setup_import_methods( + also => 'Moose::Role', + ); + + sub init_meta { + shift; + my %p = @_; + Moose::Role->init_meta(%p); + return Moose::Util::MetaRole::apply_metaclass_roles( + for_class => $p{for_class}, + method_metaclass_roles => [ 'Foo::Meta::Role', ], + ); + } +} +{ + package Role::Baz; + + Foo::Role->import; + + sub bla {} +} +{ + package My::Class12; + + use Moose; + + with( 'Role::Baz' ); +} +{ + ok( + My::Class12->meta->does_role( 'Role::Baz' ), + 'role applied' + ); + my $method = My::Class12->meta->get_method( 'bla' ); + ok( + $method->meta->does_role( 'Foo::Meta::Role' ), + 'method_metaclass_role applied' + ); +} + +{ + package Parent; + use Moose; + + Moose::Util::MetaRole::apply_metaclass_roles( + for_class => __PACKAGE__, + constructor_class_roles => ['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' + ); + +TODO: + { + local $TODO + = 'Moose 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' + ); + } +} + +done_testing; diff --git a/t/600_todo_tests/002_various_role_features.t b/t/600_todo_tests/002_various_role_features.t index deab7fe..8b6bccc 100644 --- a/t/600_todo_tests/002_various_role_features.t +++ b/t/600_todo_tests/002_various_role_features.t @@ -192,11 +192,7 @@ my $gorch = Gorch->meta; isa_ok( $gorch, "Moose::Meta::Role" ); ok( $gorch->has_attribute("attr"), "has attribute 'attr'" ); - -{ - local $TODO = "role attribute isn't a meta attribute yet"; - isa_ok( $gorch->get_attribute("attr"), "Moose::Meta::Attribute" ); -} +isa_ok( $gorch->get_attribute("attr"), "Moose::Meta::Role::Attribute" ); req_or_has($gorch, "gorch_method"); ok( $gorch->has_method("gorch_method"), "has_method gorch_method" ); @@ -226,11 +222,7 @@ my $robot = Dancer::Robot->meta; isa_ok( $robot, "Moose::Meta::Role" ); ok( $robot->has_attribute("twist"), "has attr 'twist'" ); - -{ - local $TODO = "role attribute isn't a meta attribute yet"; - isa_ok( $robot->get_attribute("twist"), "Moose::Meta::Attribute" ); -} +isa_ok( $robot->get_attribute("twist"), "Moose::Meta::Role::Attribute" ); { req_or_has($robot, "twist"); diff --git a/xt/author/pod_coverage.t b/xt/author/pod_coverage.t index d7e3e93..acfdff6 100644 --- a/xt/author/pod_coverage.t +++ b/xt/author/pod_coverage.t @@ -31,6 +31,7 @@ my %trustme = ( construct_instance create_error raise_error + reinitialize superclasses ) ], @@ -59,11 +60,13 @@ my %trustme = ( 'Moose::Meta::Role' => [ qw( alias_method get_method_modifier_list + reinitialize reset_package_cache_flag update_package_cache_flag wrap_method_body ) ], + 'Moose::Meta::Mixin::AttributeCore' => ['.+'], 'Moose::Meta::Role::Composite' => [ 'get_method', 'get_method_list', 'has_method', 'add_method' ], 'Moose::Role' => [ @@ -91,6 +94,7 @@ my %trustme = ( 'Moose::Meta::TypeConstraint::Role' => [qw( equals is_a_type_of )], 'Moose::Meta::TypeConstraint::Union' => ['compile_type_constraint'], 'Moose::Util' => ['add_method_modifier'], + 'Moose::Util::MetaRole' => ['apply_metaclass_roles'], 'Moose::Util::TypeConstraints' => ['find_or_create_type_constraint'], ); diff --git a/xt/author/pod_spell.t b/xt/author/pod_spell.t index 070db64..5e1d736 100644 --- a/xt/author/pod_spell.t +++ b/xt/author/pod_spell.t @@ -103,6 +103,7 @@ metadata MetaObject metaprogrammer metarole +metaroles metatraits mixins MooseX