From: Dave Rolsky Date: Fri, 12 Sep 2008 22:36:04 +0000 (+0000) Subject: The super-duper fix metaclass update. X-Git-Tag: 0.58~34^2~16 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f8b6827f620bd25f22b193bbec87a15d598734a3;p=gitmo%2FMoose.git The super-duper fix metaclass update. Basically, this implements the whole "if two classes differ by roles, reconcile the roles" algorithm. Along the way, this also fixes some bugs in _fix_metaclass_compatibility, where it could lose things like roles on a metaclass's attribute metaclass if the parent class's metaclass was a subclass of said metaclass (ugh, this is hard to talk about). --- diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm index 44b7972..93d8da6 100644 --- a/lib/Moose/Meta/Class.pm +++ b/lib/Moose/Meta/Class.pm @@ -7,6 +7,8 @@ use warnings; use Class::MOP; use Carp (); +use List::Util qw( first ); +use List::MoreUtils qw( any all ); use Scalar::Util 'weaken', 'blessed'; our $VERSION = '0.57'; @@ -303,77 +305,240 @@ sub _find_next_method_by_name_which_is_not_overridden { return undef; } -# Right now, this method does not handle the case where two -# metaclasses differ only in roles applied against a common parent -# class. This can happen fairly easily when ClassA applies metaclass -# Role1, and then a subclass, ClassB, applies a metaclass Role2. In -# reality, the way to resolve the problem is to apply Role1 to -# ClassB's metaclass. However, we cannot currently detect this, and so -# we simply fail to fix the incompatibility. -# -# The algorithm for fixing it is not that complicated. -# -# First, we see if the two metaclasses share a common parent (probably -# Moose::Meta::Class). -# -# Second, we see if the metaclasses only differ in terms of roles -# applied. This second point is where things break down. There is no -# easy way to determine if the difference is from roles only. To do -# that, we'd need to able to reliably determine the origin of each -# method and attribute in each metaclass. If all the unshared methods -# & attributes come from roles, and there is no name collision, then -# we can apply the missing roles to the child's metaclass. -# -# Tracking the origin of these things will require some fairly -# invasive changes to various parts of Moose & Class::MOP. -# -# For now, the workaround is for ClassB to subclass ClassA _and then_ -# apply metaclass roles to its metaclass. sub _fix_metaclass_incompatability { my ($self, @superclasses) = @_; foreach my $super (@superclasses) { - # don't bother if it does not have a meta. - my $super_meta = Class::MOP::Class->initialize($super) or next; - next unless $super_meta->isa("Class::MOP::Class"); - - # get the name, make sure we take - # immutable classes into account - my $super_meta_name - = $super_meta->is_immutable - ? $super_meta->get_mutable_metaclass_name - : ref($super_meta); - - next if - # if our metaclass is compatible - $self->isa($super_meta_name) - and - # and our instance metaclass is also compatible then no - # fixes are needed - $self->instance_metaclass->isa( $super_meta->instance_metaclass ); - - next unless $super_meta->isa( ref($self) ); + next if $self->_superclass_meta_is_compatible($super); unless ( $self->is_pristine ) { - $self->throw_error("Not reinitializing metaclass for " - . $self->name - . ", it isn't pristine"); + $self->throw_error( + "Cannot attempt to reinitialize metaclass for " + . $self->name + . ", it isn't pristine" ); } - $self = $super_meta->reinitialize( - $self->name, - attribute_metaclass => $super_meta->attribute_metaclass, - method_metaclass => $super_meta->method_metaclass, - instance_metaclass => $super_meta->instance_metaclass, - ); + return $self->_reconcile_with_superclass_meta($super); + } + + return $self; +} + +sub _superclass_meta_is_compatible { + my ($self, $super) = @_; + + my $super_meta = Class::MOP::Class->initialize($super) + or return 1; + + next unless $super_meta->isa("Class::MOP::Class"); + + my $super_meta_name + = $super_meta->is_immutable + ? $super_meta->get_mutable_metaclass_name + : ref($super_meta); + + return 1 + if $self->isa($super_meta_name) + and + $self->instance_metaclass->isa( $super_meta->instance_metaclass ); +} + +# I don't want to have to type this >1 time +my @MetaClassTypes = + qw( attribute_metaclass method_metaclass instance_metaclass constructor_class destructor_class ); + +sub _reconcile_with_superclass_meta { + my ($self, $super) = @_; + + my $super_meta = $super->meta; + + my $super_metaclass_name + = $super_meta->is_immutable + ? $super_meta->get_mutable_metaclass_name + : ref($super_meta); - $self->$_( $super_meta->$_ ) - for qw( constructor_class destructor_class ); + my $self_metaclass = ref $self; + + # If neither of these is true we have a more serious + # incompatibility that we just cannot fix (yet?). + if ( $super_metaclass_name->isa( ref $self ) + && all { $super_meta->$_->isa( $self->$_ ) } @MetaClassTypes ) { + return $self->_reinitialize_with($super_meta); + } + elsif ( $self->_all_metaclasses_differ_by_roles_only($super_meta) ) { + return $self->_reconcile_role_differences($super_meta); } return $self; } +sub _reinitialize_with { + my ( $self, $new_meta ) = @_; + + $self = $new_meta->reinitialize( + $self->name, + attribute_metaclass => $new_meta->attribute_metaclass, + method_metaclass => $new_meta->method_metaclass, + instance_metaclass => $new_meta->instance_metaclass, + ); + + $self->$_( $new_meta->$_ ) for qw( constructor_class destructor_class ); + + return $self; +} + +# In the more complex case, we share a common ancestor with our +# superclass's metaclass, but each metaclass (ours and the parent's) +# has a different set of roles applied. We reconcile this by first +# reinitializing into the parent class, and _then_ applying our own +# roles. +sub _all_metaclasses_differ_by_roles_only { + my ($self, $super_meta) = @_; + + for my $pair ( + [ ref $self, ref $super_meta ], + map { [ $self->$_, $super_meta->$_ ] } @MetaClassTypes + ) { + + next if $pair->[0] eq $pair->[1]; + + my $self_meta_meta = Class::MOP::Class->initialize( $pair->[0] ); + my $super_meta_meta = Class::MOP::Class->initialize( $pair->[1] ); + + my $common_ancestor + = _find_common_ancestor( $self_meta_meta, $super_meta_meta ); + + return unless $common_ancestor; + + return + unless _is_role_only_subclass_of( + $self_meta_meta, + $common_ancestor, + ) + && _is_role_only_subclass_of( + $super_meta_meta, + $common_ancestor, + ); + } + + return 1; +} + +# This, and some other functions, could be called as methods, but +# they're not for two reasons. One, we just end up ignoring the first +# argument, because we can't call these directly on one of the real +# arguments, because one of them could be a Class::MOP::Class object +# and not a Moose::Meta::Class. Second, only a completely insane +# person would attempt to subclass this stuff! +sub _find_common_ancestor { + my ($meta1, $meta2) = @_; + + # FIXME? This doesn't account for multiple inheritance (not sure + # if it needs to though). For example, is somewhere in $meta1's + # history it inherits from both ClassA and ClassB, and $meta + # inherits from ClassB & ClassA, does it matter? And what crazy + # fool would do that anyway? + + my %meta1_parents = map { $_ => 1 } $meta1->linearized_isa; + + return first { $meta1_parents{$_} } $meta2->linearized_isa; +} + +sub _is_role_only_subclass_of { + my ($meta, $ancestor) = @_; + + return 1 if $meta->name eq $ancestor; + + my @roles = _all_roles_until( $meta, $ancestor ); + + my %role_packages = map { $_->name => 1 } @roles; + + my $ancestor_meta = Class::MOP::Class->initialize($ancestor); + + my %shared_ancestors = map { $_ => 1 } $ancestor_meta->linearized_isa; + + for my $method ( $meta->get_all_methods() ) { + next if $method->name eq 'meta'; + next if $method->can('associated_attribute'); + + next + if $role_packages{ $method->original_package_name } + || $shared_ancestors{ $method->original_package_name }; + + return 0; + } + + # FIXME - this really isn't right. Just because an attribute is + # defined in a role doesn't mean it isn't _also_ defined in the + # subclass. + for my $attr ( $meta->get_all_attributes ) { + next if $shared_ancestors{ $attr->associated_class->name }; + + next if any { $_->has_attribute( $attr->name ) } @roles; + + return 0; + } + + return 1; +} + +sub _all_roles { + my $meta = shift; + + return _all_roles_until($meta); +} + +sub _all_roles_until { + my ($meta, $stop_at_class) = @_; + + return unless $meta->can('calculate_all_roles'); + + my @roles = $meta->calculate_all_roles; + + for my $class ( $meta->linearized_isa ) { + last if $stop_at_class && $stop_at_class eq $class; + + my $meta = Class::MOP::Class->initialize($class); + last unless $meta->can('calculate_all_roles'); + + push @roles, $meta->calculate_all_roles; + } + + return @roles; +} + +sub _reconcile_role_differences { + my ($self, $super_meta) = @_; + + my $self_meta = $self->meta; + + my %roles; + + if ( my @roles = map { $_->name } _all_roles($self_meta) ) { + $roles{metaclass_roles} = \@roles; + } + + for my $thing (@MetaClassTypes) { + my $name = $self->$thing(); + + my $thing_meta = Class::MOP::Class->initialize($name); + + my @roles = map { $_->name } _all_roles($thing_meta) + or next; + + $roles{ $thing . '_roles' } = \@roles; + } + + $self = $self->_reinitialize_with($super_meta); + + Moose::Util::MetaRole::apply_metaclass_roles( + for_class => $self->name, + %roles, + ); + + return $self; +} + # NOTE: # this was crap anyway, see # Moose::Util::apply_all_roles diff --git a/t/050_metaclasses/015_metarole.t b/t/050_metaclasses/015_metarole.t index 97209a5..0df8d4d 100644 --- a/t/050_metaclasses/015_metarole.t +++ b/t/050_metaclasses/015_metarole.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 59; +use Test::More tests => 66; use Moose::Util::MetaRole; @@ -15,36 +15,6 @@ use Moose::Util::MetaRole; } { - package My::Meta::Attribute; - use Moose; - extends 'Moose::Meta::Attribute'; -} - -{ - package My::Meta::Method; - use Moose; - extends 'Moose::Meta::Method'; -} - -{ - package My::Meta::Instance; - use Moose; - extends 'Moose::Meta::Instance'; -} - -{ - package My::Meta::MethodConstructor; - use Moose; - extends 'Moose::Meta::Method::Constructor'; -} - -{ - package My::Meta::MethodDestructor; - use Moose; - extends 'Moose::Meta::Method::Destructor'; -} - -{ package Role::Foo; use Moose::Role; has 'foo' => ( is => 'ro', default => 10 ); @@ -331,12 +301,6 @@ use Moose::Util::MetaRole; q{... and My::Class5->meta() still does Role::Foo} ); } -SKIP: -{ - skip - 'These tests will fail until Moose::Meta::Class->_fix_metaclass_incompatibility is much smarter.', - 2; - { package My::Class6; use Moose; @@ -353,14 +317,14 @@ SKIP: 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 it extends My::Class} ); -} + q{... and My::Class6->meta() does Role::Foo because My::Class6 extends My::Class} ); } -# This is the hack needed to work around the -# _fix_metaclass_incompatibility problem. You must call extends() -# (which in turn calls _fix_metaclass_imcompatibility) _before_ you -# apply more extensions in the subclass. +# 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; @@ -379,5 +343,51 @@ SKIP: 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 it extends My::Class} ); + 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} ); }