From: Jesse Luehrs Date: Fri, 16 Apr 2010 08:28:00 +0000 (-0500) Subject: fix some immutability issues, and expand the tests X-Git-Tag: 1.05~16 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9f83eb5d9d83e4c3cd8d3768e269503b74f55215;p=gitmo%2FMoose.git fix some immutability issues, and expand the tests --- diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm index 6eca2e0..a02851a 100644 --- a/lib/Moose/Meta/Class.pm +++ b/lib/Moose/Meta/Class.pm @@ -200,6 +200,16 @@ sub calculate_all_roles { grep { !$seen{$_->name}++ } map { $_->calculate_all_roles } @{ $self->roles }; } +sub calculate_all_roles_with_inheritance { + my $self = shift; + my %seen; + grep { !$seen{$_->name}++ } + map { Class::MOP::class_of($_)->can('calculate_all_roles') + ? Class::MOP::class_of($_)->calculate_all_roles + : () } + $self->linearized_isa; +} + sub does_role { my ($self, $role_name) = @_; @@ -412,10 +422,7 @@ sub _is_role_only_subclass { # subclass. for my $attr (map { $meta->get_attribute($_) } $meta->get_attribute_list) { next if any { $_->has_attribute($attr->name) } - map { $_->meta->can('calculate_all_roles') - ? $_->meta->calculate_all_roles - : () } - $meta->linearized_isa; + $meta->calculate_all_roles_with_inheritance; return 0; } @@ -427,13 +434,16 @@ sub _can_fix_class_metaclass_incompatibility_by_role_reconciliation { my $self = shift; my ($super_meta) = @_; - my $common_base_name = $self->_find_common_base(blessed($self), blessed($super_meta)); + my $super_meta_name = $super_meta->is_immutable + ? $super_meta->_get_mutable_metaclass_name + : blessed($super_meta); + my $common_base_name = $self->_find_common_base(blessed($self), $super_meta_name); # if they're not both moose metaclasses, and the cmop fixing couldn't # do anything, there's nothing more we can do return unless defined($common_base_name); return unless $common_base_name->isa('Moose::Meta::Class'); - my @super_meta_name_ancestor_names = $self->_get_ancestors_until(blessed($super_meta), $common_base_name); + my @super_meta_name_ancestor_names = $self->_get_ancestors_until($super_meta_name, $common_base_name); my @class_meta_name_ancestor_names = $self->_get_ancestors_until(blessed($self), $common_base_name); # we're only dealing with roles here return unless all { $self->_is_role_only_subclass($_) } @@ -471,11 +481,11 @@ sub _can_fix_single_metaclass_incompatibility_by_role_reconciliation { sub _role_differences { my $self = shift; my ($class_meta_name, $super_meta_name) = @_; - my @super_role_metas = $super_meta_name->meta->can('calculate_all_roles') - ? $super_meta_name->meta->calculate_all_roles + my @super_role_metas = $super_meta_name->meta->can('calculate_all_roles_with_inheritance') + ? $super_meta_name->meta->calculate_all_roles_with_inheritance : (); - my @role_metas = $class_meta_name->meta->can('calculate_all_roles') - ? $class_meta_name->meta->calculate_all_roles + my @role_metas = $class_meta_name->meta->can('calculate_all_roles_with_inheritance') + ? $class_meta_name->meta->calculate_all_roles_with_inheritance : (); my @differences; for my $role_meta (@role_metas) { @@ -492,7 +502,7 @@ sub _reconcile_roles_for_metaclass { my @role_differences = $self->_role_differences( $class_meta_name, $super_meta_name, ); - return $self->create_anon_class( + return Moose::Meta::Class->create_anon_class( superclasses => [$super_meta_name], roles => \@role_differences, cache => 1, @@ -527,7 +537,10 @@ sub _fix_class_metaclass_incompatibility { $self->SUPER::_fix_class_metaclass_incompatibility(@_); if ($self->_can_fix_class_metaclass_incompatibility_by_role_reconciliation($super_meta)) { - my $class_meta_subclass_meta = $self->_reconcile_roles_for_metaclass(blessed($self), blessed($super_meta)); + my $super_meta_name = $super_meta->is_immutable + ? $super_meta->_get_mutable_metaclass_name + : blessed($super_meta); + my $class_meta_subclass_meta = $self->_reconcile_roles_for_metaclass(blessed($self), $super_meta_name); my $new_self = $class_meta_subclass_meta->name->reinitialize( $self->name, ); @@ -743,6 +756,11 @@ This adds an C method modifier to the package. This will return a unique array of C instances which are attached to this class. +=item B<< $metaclass->calculate_all_roles_with_inheritance >> + +This will return a unique array of C instances +which are attached to this class, and each of this class's ancestors. + =item B<< $metaclass->add_role($role) >> This takes a L object, and adds it to the class's diff --git a/t/050_metaclasses/052_metaclass_compat.t b/t/050_metaclasses/052_metaclass_compat.t index f09dcf5..dc9e4db 100644 --- a/t/050_metaclasses/052_metaclass_compat.t +++ b/t/050_metaclasses/052_metaclass_compat.t @@ -64,7 +64,6 @@ ok(Foo::Sub->meta->constructor_class->meta->can('does_role') { package Foo2; use Moose -traits => ['Foo2::Role']; - __PACKAGE__->meta->make_immutable; } { package Bar2; @@ -74,11 +73,141 @@ ok(Foo::Sub->meta->constructor_class->meta->can('does_role') package Baz2; use Moose; my $meta = __PACKAGE__->meta; - $meta->superclasses('Foo2'); - { our $TODO; local $TODO = "need to handle immutability better"; - ::lives_ok { $meta->superclasses('Bar2') }; - ::lives_ok { $meta->make_mutable if $meta->is_immutable }; - } + ::lives_ok { $meta->superclasses('Foo2') } "can set superclasses once"; + ::isa_ok($meta, Foo2->meta->meta->name); + ::lives_ok { $meta->superclasses('Bar2') } "can still set superclasses"; + ::isa_ok($meta, Bar2->meta->meta->name); + ::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance], + ['Foo2::Role'], + "still have the role attached"); + ::ok(!$meta->is_immutable, + "immutable superclass doesn't make this class immutable"); + ::lives_ok { $meta->make_immutable } "can still make immutable"; +} +{ + package Foo3::Role; + use Moose::Role; +} +{ + package Bar3; + use Moose -traits => ['Foo3::Role']; +} +{ + package Baz3; + use Moose -traits => ['Foo3::Role']; + my $meta = __PACKAGE__->meta; + ::lives_ok { $meta->superclasses('Foo2') } "can set superclasses once"; + ::isa_ok($meta, Foo2->meta->meta->name); + ::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance], + ['Foo2::Role', 'Foo3::Role'], + "reconciled roles correctly"); + ::lives_ok { $meta->superclasses('Bar3') } "can still set superclasses"; + ::isa_ok($meta, Bar3->meta->meta->name); + ::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance], + ['Foo2::Role', 'Foo3::Role'], + "roles still the same"); + ::ok(!$meta->is_immutable, + "immutable superclass doesn't make this class immutable"); + ::lives_ok { $meta->make_immutable } "can still make immutable"; +} +{ + package Quux3; + use Moose; +} +{ + package Quuux3; + use Moose -traits => ['Foo3::Role']; + my $meta = __PACKAGE__->meta; + ::lives_ok { $meta->superclasses('Foo2') } "can set superclasses once"; + ::isa_ok($meta, Foo2->meta->meta->name); + ::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance], + ['Foo2::Role', 'Foo3::Role'], + "reconciled roles correctly"); + ::lives_ok { $meta->superclasses('Quux3') } "can still set superclasses"; + ::isa_ok($meta, Quux3->meta->meta->name); + ::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance], + ['Foo2::Role', 'Foo3::Role'], + "roles still the same"); + ::ok(!$meta->is_immutable, + "immutable superclass doesn't make this class immutable"); + ::lives_ok { $meta->make_immutable } "can still make immutable"; +} + +{ + package Foo4::Role; + use Moose::Role; +} +{ + package Foo4; + use Moose -traits => ['Foo4::Role']; + __PACKAGE__->meta->make_immutable; +} +{ + package Bar4; + use Moose; +} +{ + package Baz4; + use Moose; + my $meta = __PACKAGE__->meta; + ::lives_ok { $meta->superclasses('Foo4') } "can set superclasses once"; + ::isa_ok($meta, Foo4->meta->_get_mutable_metaclass_name); + ::lives_ok { $meta->superclasses('Bar4') } "can still set superclasses"; + ::isa_ok($meta, Bar4->meta->meta->name); + ::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance], + ['Foo4::Role'], + "still have the role attached"); + ::ok(!$meta->is_immutable, + "immutable superclass doesn't make this class immutable"); + ::lives_ok { $meta->make_immutable } "can still make immutable"; +} +{ + package Foo5::Role; + use Moose::Role; +} +{ + package Bar5; + use Moose -traits => ['Foo5::Role']; +} +{ + package Baz5; + use Moose -traits => ['Foo5::Role']; + my $meta = __PACKAGE__->meta; + ::lives_ok { $meta->superclasses('Foo4') } "can set superclasses once"; + ::isa_ok($meta, Foo4->meta->_get_mutable_metaclass_name); + ::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance], + ['Foo4::Role', 'Foo5::Role'], + "reconciled roles correctly"); + ::lives_ok { $meta->superclasses('Bar5') } "can still set superclasses"; + ::isa_ok($meta, Bar5->meta->meta->name); + ::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance], + ['Foo4::Role', 'Foo5::Role'], + "roles still the same"); + ::ok(!$meta->is_immutable, + "immutable superclass doesn't make this class immutable"); + ::lives_ok { $meta->make_immutable } "can still make immutable"; +} +{ + package Quux5; + use Moose; +} +{ + package Quuux5; + use Moose -traits => ['Foo5::Role']; + my $meta = __PACKAGE__->meta; + ::lives_ok { $meta->superclasses('Foo4') } "can set superclasses once"; + ::isa_ok($meta, Foo4->meta->_get_mutable_metaclass_name); + ::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance], + ['Foo4::Role', 'Foo5::Role'], + "reconciled roles correctly"); + ::lives_ok { $meta->superclasses('Quux5') } "can still set superclasses"; + ::isa_ok($meta, Quux5->meta->meta->name); + ::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance], + ['Foo4::Role', 'Foo5::Role'], + "roles still the same"); + ::ok(!$meta->is_immutable, + "immutable superclass doesn't make this class immutable"); + ::lives_ok { $meta->make_immutable } "can still make immutable"; } done_testing;