diff options
Diffstat (limited to 't/metaclasses/metaclass_compat.t')
| -rw-r--r-- | t/metaclasses/metaclass_compat.t | 304 |
1 files changed, 304 insertions, 0 deletions
diff --git a/t/metaclasses/metaclass_compat.t b/t/metaclasses/metaclass_compat.t new file mode 100644 index 0000000..8ef2343 --- /dev/null +++ b/t/metaclasses/metaclass_compat.t @@ -0,0 +1,304 @@ +use strict; +use warnings; +use lib 't/lib'; +use Test::More; +use Test::Fatal; + +our $called = 0; +{ + package Foo::Trait::Class; + use Moose::Role; + + around _inline_BUILDALL => sub { + my $orig = shift; + my $self = shift; + return ( + $self->$orig(@_), + '$::called++;' + ); + } +} + +{ + package Foo; + use Moose; + Moose::Util::MetaRole::apply_metaroles( + for => __PACKAGE__, + class_metaroles => { + class => ['Foo::Trait::Class'], + } + ); +} + +Foo->new; +is($called, 0, "no calls before inlining"); +Foo->meta->make_immutable; + +Foo->new; +is($called, 1, "inlined constructor has trait modifications"); + +ok(Foo->meta->meta->does_role('Foo::Trait::Class'), + "class has correct traits"); + +{ + package Foo::Sub; + use Moose; + extends 'Foo'; +} + +$called = 0; + +Foo::Sub->new; +is($called, 0, "no calls before inlining"); + +Foo::Sub->meta->make_immutable; + +Foo::Sub->new; +is($called, 1, "inherits trait properly"); + +ok(Foo::Sub->meta->meta->can('does_role') +&& Foo::Sub->meta->meta->does_role('Foo::Trait::Class'), + "subclass inherits traits"); + +{ + package Foo2::Role; + use Moose::Role; +} +{ + package Foo2; + use Moose -traits => ['Foo2::Role']; +} +{ + package Bar2; + use Moose; +} +{ + package Baz2; + use Moose; + my $meta = __PACKAGE__->meta; + ::is( ::exception { $meta->superclasses('Foo2') }, undef, "can set superclasses once" ); + ::isa_ok($meta, Foo2->meta->meta->name); + ::is( ::exception { $meta->superclasses('Bar2') }, undef, "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"); + ::is( ::exception { $meta->make_immutable }, undef, "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; + ::is( ::exception { $meta->superclasses('Foo2') }, undef, "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"); + ::is( ::exception { $meta->superclasses('Bar3') }, undef, "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"); + ::is( ::exception { $meta->make_immutable }, undef, "can still make immutable" ); +} +{ + package Quux3; + use Moose; +} +{ + package Quuux3; + use Moose -traits => ['Foo3::Role']; + my $meta = __PACKAGE__->meta; + ::is( ::exception { $meta->superclasses('Foo2') }, undef, "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"); + ::is( ::exception { $meta->superclasses('Quux3') }, undef, "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"); + ::is( ::exception { $meta->make_immutable }, undef, "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; + ::is( ::exception { $meta->superclasses('Foo4') }, undef, "can set superclasses once" ); + ::isa_ok($meta, Foo4->meta->_get_mutable_metaclass_name); + ::is( ::exception { $meta->superclasses('Bar4') }, undef, "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"); + ::is( ::exception { $meta->make_immutable }, undef, "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; + ::is( ::exception { $meta->superclasses('Foo4') }, undef, "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"); + ::is( ::exception { $meta->superclasses('Bar5') }, undef, "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"); + ::is( ::exception { $meta->make_immutable }, undef, "can still make immutable" ); +} +{ + package Quux5; + use Moose; +} +{ + package Quuux5; + use Moose -traits => ['Foo5::Role']; + my $meta = __PACKAGE__->meta; + ::is( ::exception { $meta->superclasses('Foo4') }, undef, "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"); + ::is( ::exception { $meta->superclasses('Quux5') }, undef, "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"); + ::is( ::exception { $meta->make_immutable }, undef, "can still make immutable" ); +} + +{ + package Foo5::Meta::Role; + use Moose::Role; +} +{ + package Foo5::SuperClass::WithMetaRole; + use Moose -traits =>'Foo5::Meta::Role'; +} +{ + package Foo5::SuperClass::After::Attribute; + use Moose; +} +{ + package Foo5; + use Moose; + my @superclasses = ('Foo5::SuperClass::WithMetaRole'); + extends @superclasses; + + has an_attribute_generating_methods => ( is => 'ro' ); + + push(@superclasses, 'Foo5::SuperClass::After::Attribute'); + + ::is( ::exception { + extends @superclasses; + }, undef, 'MI extends after_generated_methods with metaclass roles' ); + ::is( ::exception { + extends reverse @superclasses; + }, undef, 'MI extends after_generated_methods with metaclass roles (reverse)' ); +} + +{ + package Foo6::Meta::Role; + use Moose::Role; +} +{ + package Foo6::SuperClass::WithMetaRole; + use Moose -traits =>'Foo6::Meta::Role'; +} +{ + package Foo6::Meta::OtherRole; + use Moose::Role; +} +{ + package Foo6::SuperClass::After::Attribute; + use Moose -traits =>'Foo6::Meta::OtherRole'; +} +{ + package Foo6; + use Moose; + my @superclasses = ('Foo6::SuperClass::WithMetaRole'); + extends @superclasses; + + has an_attribute_generating_methods => ( is => 'ro' ); + + push(@superclasses, 'Foo6::SuperClass::After::Attribute'); + + ::like( ::exception { + extends @superclasses; + }, qr/compat.*pristine/, 'unsafe MI extends after_generated_methods with metaclass roles' ); + ::like( ::exception { + extends reverse @superclasses; + }, qr/compat.*pristine/, 'unsafe MI extends after_generated_methods with metaclass roles (reverse)' ); +} + +{ + package Foo7::Meta::Trait; + use Moose::Role; +} + +{ + package Foo7; + use Moose -traits => ['Foo7::Meta::Trait']; +} + +{ + package Bar7; + # in an external file + use Moose -traits => ['Bar7::Meta::Trait']; + ::is( ::exception { extends 'Foo7' }, undef, "role reconciliation works" ); +} + +{ + package Bar72; + # in an external file + use Moose -traits => ['Bar7::Meta::Trait2']; + ::is( ::exception { extends 'Foo7' }, undef, "role reconciliation works" ); +} + +done_testing; |