[gitmo/Moose.git] / t / 050_metaclasses / 052_metaclass_compat.t

#!/usr/bin/env perl
use strict;
use warnings;
use lib 't/lib';
use Test::More;
use Test::Fatal;

our $called = 0;
{
    package Foo::Trait::Constructor;
    use Moose::Role;

    around _generate_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 => {
            constructor => ['Foo::Trait::Constructor'],
        }
    );
}

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->constructor_class->meta->does_role('Foo::Trait::Constructor'),
   "class has correct constructor 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 constructor trait properly");

ok(Foo::Sub->meta->constructor_class->meta->can('does_role')
&& Foo::Sub->meta->constructor_class->meta->does_role('Foo::Trait::Constructor'),
   "subclass inherits constructor 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;
Commit	Line	Data
6d6d2327	1	#!/usr/bin/env perl
	2	use strict;
	3	use warnings;
38bf6bf3	4	use lib 't/lib';
6d6d2327	5	use Test::More;
b10dde3a	6	use Test::Fatal;
6d6d2327	7
	8	our $called = 0;
	9	{
	10	package Foo::Trait::Constructor;
	11	use Moose::Role;
	12
	13	around _generate_BUILDALL => sub {
	14	my $orig = shift;
	15	my $self = shift;
	16	return $self->$orig(@_) . '$::called++;';
	17	}
	18	}
	19
	20	{
	21	package Foo;
	22	use Moose;
	23	Moose::Util::MetaRole::apply_metaroles(
	24	for => __PACKAGE__,
	25	class_metaroles => {
	26	constructor => ['Foo::Trait::Constructor'],
	27	}
	28	);
	29	}
	30
	31	Foo->new;
	32	is($called, 0, "no calls before inlining");
	33	Foo->meta->make_immutable;
	34
	35	Foo->new;
	36	is($called, 1, "inlined constructor has trait modifications");
	37
	38	ok(Foo->meta->constructor_class->meta->does_role('Foo::Trait::Constructor'),
	39	"class has correct constructor traits");
	40
	41	{
	42	package Foo::Sub;
	43	use Moose;
	44	extends 'Foo';
	45	}
	46
63eeb72b	47	$called = 0;
	48
	49	Foo::Sub->new;
	50	is($called, 0, "no calls before inlining");
	51
	52	Foo::Sub->meta->make_immutable;
	53
6d6d2327	54	Foo::Sub->new;
63eeb72b	55	is($called, 1, "inherits constructor trait properly");
6d6d2327	56
	57	ok(Foo::Sub->meta->constructor_class->meta->can('does_role')
	58	&& Foo::Sub->meta->constructor_class->meta->does_role('Foo::Trait::Constructor'),
	59	"subclass inherits constructor traits");
6d6d2327	60
f4eea413	61	{
	62	package Foo2::Role;
	63	use Moose::Role;
	64	}
	65	{
	66	package Foo2;
	67	use Moose -traits => ['Foo2::Role'];
f4eea413	68	}
	69	{
	70	package Bar2;
	71	use Moose;
	72	}
	73	{
	74	package Baz2;
	75	use Moose;
	76	my $meta = __PACKAGE__->meta;
b10dde3a	77	::is( ::exception { $meta->superclasses('Foo2') }, undef, "can set superclasses once" );
9f83eb5d	78	::isa_ok($meta, Foo2->meta->meta->name);
b10dde3a	79	::is( ::exception { $meta->superclasses('Bar2') }, undef, "can still set superclasses" );
9f83eb5d	80	::isa_ok($meta, Bar2->meta->meta->name);
	81	::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance],
	82	['Foo2::Role'],
	83	"still have the role attached");
	84	::ok(!$meta->is_immutable,
	85	"immutable superclass doesn't make this class immutable");
b10dde3a	86	::is( ::exception { $meta->make_immutable }, undef, "can still make immutable" );
9f83eb5d	87	}
	88	{
	89	package Foo3::Role;
	90	use Moose::Role;
	91	}
	92	{
	93	package Bar3;
	94	use Moose -traits => ['Foo3::Role'];
	95	}
	96	{
	97	package Baz3;
	98	use Moose -traits => ['Foo3::Role'];
	99	my $meta = __PACKAGE__->meta;
b10dde3a	100	::is( ::exception { $meta->superclasses('Foo2') }, undef, "can set superclasses once" );
9f83eb5d	101	::isa_ok($meta, Foo2->meta->meta->name);
	102	::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance],
	103	['Foo2::Role', 'Foo3::Role'],
	104	"reconciled roles correctly");
b10dde3a	105	::is( ::exception { $meta->superclasses('Bar3') }, undef, "can still set superclasses" );
9f83eb5d	106	::isa_ok($meta, Bar3->meta->meta->name);
	107	::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance],
	108	['Foo2::Role', 'Foo3::Role'],
	109	"roles still the same");
	110	::ok(!$meta->is_immutable,
	111	"immutable superclass doesn't make this class immutable");
b10dde3a	112	::is( ::exception { $meta->make_immutable }, undef, "can still make immutable" );
9f83eb5d	113	}
	114	{
	115	package Quux3;
	116	use Moose;
	117	}
	118	{
	119	package Quuux3;
	120	use Moose -traits => ['Foo3::Role'];
	121	my $meta = __PACKAGE__->meta;
b10dde3a	122	::is( ::exception { $meta->superclasses('Foo2') }, undef, "can set superclasses once" );
9f83eb5d	123	::isa_ok($meta, Foo2->meta->meta->name);
	124	::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance],
	125	['Foo2::Role', 'Foo3::Role'],
	126	"reconciled roles correctly");
b10dde3a	127	::is( ::exception { $meta->superclasses('Quux3') }, undef, "can still set superclasses" );
9f83eb5d	128	::isa_ok($meta, Quux3->meta->meta->name);
	129	::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance],
	130	['Foo2::Role', 'Foo3::Role'],
	131	"roles still the same");
	132	::ok(!$meta->is_immutable,
	133	"immutable superclass doesn't make this class immutable");
b10dde3a	134	::is( ::exception { $meta->make_immutable }, undef, "can still make immutable" );
9f83eb5d	135	}
	136
	137	{
	138	package Foo4::Role;
	139	use Moose::Role;
	140	}
	141	{
	142	package Foo4;
	143	use Moose -traits => ['Foo4::Role'];
	144	__PACKAGE__->meta->make_immutable;
	145	}
	146	{
	147	package Bar4;
	148	use Moose;
	149	}
	150	{
	151	package Baz4;
	152	use Moose;
	153	my $meta = __PACKAGE__->meta;
b10dde3a	154	::is( ::exception { $meta->superclasses('Foo4') }, undef, "can set superclasses once" );
9f83eb5d	155	::isa_ok($meta, Foo4->meta->_get_mutable_metaclass_name);
b10dde3a	156	::is( ::exception { $meta->superclasses('Bar4') }, undef, "can still set superclasses" );
9f83eb5d	157	::isa_ok($meta, Bar4->meta->meta->name);
	158	::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance],
	159	['Foo4::Role'],
	160	"still have the role attached");
	161	::ok(!$meta->is_immutable,
	162	"immutable superclass doesn't make this class immutable");
b10dde3a	163	::is( ::exception { $meta->make_immutable }, undef, "can still make immutable" );
9f83eb5d	164	}
	165	{
	166	package Foo5::Role;
	167	use Moose::Role;
	168	}
	169	{
	170	package Bar5;
	171	use Moose -traits => ['Foo5::Role'];
	172	}
	173	{
	174	package Baz5;
	175	use Moose -traits => ['Foo5::Role'];
	176	my $meta = __PACKAGE__->meta;
b10dde3a	177	::is( ::exception { $meta->superclasses('Foo4') }, undef, "can set superclasses once" );
9f83eb5d	178	::isa_ok($meta, Foo4->meta->_get_mutable_metaclass_name);
	179	::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance],
	180	['Foo4::Role', 'Foo5::Role'],
	181	"reconciled roles correctly");
b10dde3a	182	::is( ::exception { $meta->superclasses('Bar5') }, undef, "can still set superclasses" );
9f83eb5d	183	::isa_ok($meta, Bar5->meta->meta->name);
	184	::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance],
	185	['Foo4::Role', 'Foo5::Role'],
	186	"roles still the same");
	187	::ok(!$meta->is_immutable,
	188	"immutable superclass doesn't make this class immutable");
b10dde3a	189	::is( ::exception { $meta->make_immutable }, undef, "can still make immutable" );
9f83eb5d	190	}
	191	{
	192	package Quux5;
	193	use Moose;
	194	}
	195	{
	196	package Quuux5;
	197	use Moose -traits => ['Foo5::Role'];
	198	my $meta = __PACKAGE__->meta;
b10dde3a	199	::is( ::exception { $meta->superclasses('Foo4') }, undef, "can set superclasses once" );
9f83eb5d	200	::isa_ok($meta, Foo4->meta->_get_mutable_metaclass_name);
	201	::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance],
	202	['Foo4::Role', 'Foo5::Role'],
	203	"reconciled roles correctly");
b10dde3a	204	::is( ::exception { $meta->superclasses('Quux5') }, undef, "can still set superclasses" );
9f83eb5d	205	::isa_ok($meta, Quux5->meta->meta->name);
	206	::is_deeply([sort map { $_->name } $meta->meta->calculate_all_roles_with_inheritance],
	207	['Foo4::Role', 'Foo5::Role'],
	208	"roles still the same");
	209	::ok(!$meta->is_immutable,
	210	"immutable superclass doesn't make this class immutable");
b10dde3a	211	::is( ::exception { $meta->make_immutable }, undef, "can still make immutable" );
f4eea413	212	}
f4eea413	213
76176929	214	{
	215	package Foo5::Meta::Role;
	216	use Moose::Role;
	217	}
	218	{
	219	package Foo5::SuperClass::WithMetaRole;
	220	use Moose -traits =>'Foo5::Meta::Role';
	221	}
	222	{
	223	package Foo5::SuperClass::After::Attribute;
	224	use Moose;
	225	}
	226	{
	227	package Foo5;
	228	use Moose;
	229	my @superclasses = ('Foo5::SuperClass::WithMetaRole');
	230	extends @superclasses;
	231
	232	has an_attribute_generating_methods => ( is => 'ro' );
	233
	234	push(@superclasses, 'Foo5::SuperClass::After::Attribute');
	235
b10dde3a	236	::is( ::exception {
76176929	237	extends @superclasses;
b10dde3a	238	}, undef, 'MI extends after_generated_methods with metaclass roles' );
b10dde3a	239	::is( ::exception {
76176929	240	extends reverse @superclasses;
b10dde3a	241	}, undef, 'MI extends after_generated_methods with metaclass roles (reverse)' );
76176929	242	}
76176929	243
590e8894	244	{
	245	package Foo6::Meta::Role;
	246	use Moose::Role;
	247	}
	248	{
	249	package Foo6::SuperClass::WithMetaRole;
	250	use Moose -traits =>'Foo6::Meta::Role';
	251	}
	252	{
	253	package Foo6::Meta::OtherRole;
	254	use Moose::Role;
	255	}
	256	{
	257	package Foo6::SuperClass::After::Attribute;
	258	use Moose -traits =>'Foo6::Meta::OtherRole';
	259	}
	260	{
	261	package Foo6;
	262	use Moose;
	263	my @superclasses = ('Foo6::SuperClass::WithMetaRole');
	264	extends @superclasses;
	265
	266	has an_attribute_generating_methods => ( is => 'ro' );
	267
	268	push(@superclasses, 'Foo6::SuperClass::After::Attribute');
	269
b10dde3a	270	::like( ::exception {
590e8894	271	extends @superclasses;
b10dde3a	272	}, qr/compat.*pristine/, 'unsafe MI extends after_generated_methods with metaclass roles' );
b10dde3a	273	::like( ::exception {
590e8894	274	extends reverse @superclasses;
b10dde3a	275	}, qr/compat.*pristine/, 'unsafe MI extends after_generated_methods with metaclass roles (reverse)' );
590e8894	276	}
590e8894	277
38bf6bf3	278	{
	279	package Foo7::Meta::Trait;
	280	use Moose::Role;
	281	}
	282
	283	{
	284	package Foo7;
	285	use Moose -traits => ['Foo7::Meta::Trait'];
	286	}
	287
	288	{
	289	package Bar7;
	290	# in an external file
	291	use Moose -traits => ['Bar7::Meta::Trait'];
b10dde3a	292	::is( ::exception { extends 'Foo7' }, undef, "role reconciliation works" );
38bf6bf3	293	}
	294
	295	{
	296	package Bar72;
	297	# in an external file
	298	use Moose -traits => ['Bar7::Meta::Trait2'];
b10dde3a	299	::is( ::exception { extends 'Foo7' }, undef, "role reconciliation works" );
38bf6bf3	300	}
38bf6bf3	301
6d6d2327	302	done_testing;