#!/usr/bin/env perl
use strict;
use warnings;
+use lib 't/lib';
use Test::More;
-use Test::Exception;
+use Test::Fatal;
our $called = 0;
{
{
package Foo2;
use Moose -traits => ['Foo2::Role'];
- __PACKAGE__->meta->make_immutable;
}
{
package Bar2;
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 };
- }
+ ::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;