[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::Exception;

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;
    ::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";
}

{
    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');

    ::lives_ok {
        extends @superclasses;
    } 'MI extends after_generated_methods with metaclass roles';
    ::lives_ok {
        extends reverse @superclasses;
    }
    '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');

    ::throws_ok {
        extends @superclasses;
    } qr/compat.*pristine/,
    'unsafe MI extends after_generated_methods with metaclass roles';
    ::throws_ok {
        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'];
    ::lives_ok { extends 'Foo7' } "role reconciliation works";
}

{
    package Bar72;
    # in an external file
    use Moose -traits => ['Bar7::Meta::Trait2'];
    ::lives_ok { extends 'Foo7' } "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;
53a4d826	6	use Test::Exception;
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;
53a4d826	77	::lives_ok { $meta->superclasses('Foo2') } "can set superclasses once";
9f83eb5d	78	::isa_ok($meta, Foo2->meta->meta->name);
53a4d826	79	::lives_ok { $meta->superclasses('Bar2') } "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");
53a4d826	86	::lives_ok { $meta->make_immutable } "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;
53a4d826	100	::lives_ok { $meta->superclasses('Foo2') } "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");
53a4d826	105	::lives_ok { $meta->superclasses('Bar3') } "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");
53a4d826	112	::lives_ok { $meta->make_immutable } "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;
53a4d826	122	::lives_ok { $meta->superclasses('Foo2') } "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");
53a4d826	127	::lives_ok { $meta->superclasses('Quux3') } "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");
53a4d826	134	::lives_ok { $meta->make_immutable } "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;
53a4d826	154	::lives_ok { $meta->superclasses('Foo4') } "can set superclasses once";
9f83eb5d	155	::isa_ok($meta, Foo4->meta->_get_mutable_metaclass_name);
53a4d826	156	::lives_ok { $meta->superclasses('Bar4') } "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");
53a4d826	163	::lives_ok { $meta->make_immutable } "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;
53a4d826	177	::lives_ok { $meta->superclasses('Foo4') } "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");
53a4d826	182	::lives_ok { $meta->superclasses('Bar5') } "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");
53a4d826	189	::lives_ok { $meta->make_immutable } "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;
53a4d826	199	::lives_ok { $meta->superclasses('Foo4') } "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");
53a4d826	204	::lives_ok { $meta->superclasses('Quux5') } "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");
53a4d826	211	::lives_ok { $meta->make_immutable } "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
53a4d826	236	::lives_ok {
76176929	237	extends @superclasses;
53a4d826	238	} 'MI extends after_generated_methods with metaclass roles';
53a4d826	239	::lives_ok {
76176929	240	extends reverse @superclasses;
53a4d826	241	}
76176929	242	'MI extends after_generated_methods with metaclass roles (reverse)';
	243	}
	244
590e8894	245	{
	246	package Foo6::Meta::Role;
	247	use Moose::Role;
	248	}
	249	{
	250	package Foo6::SuperClass::WithMetaRole;
	251	use Moose -traits =>'Foo6::Meta::Role';
	252	}
	253	{
	254	package Foo6::Meta::OtherRole;
	255	use Moose::Role;
	256	}
	257	{
	258	package Foo6::SuperClass::After::Attribute;
	259	use Moose -traits =>'Foo6::Meta::OtherRole';
	260	}
	261	{
	262	package Foo6;
	263	use Moose;
	264	my @superclasses = ('Foo6::SuperClass::WithMetaRole');
	265	extends @superclasses;
	266
	267	has an_attribute_generating_methods => ( is => 'ro' );
	268
	269	push(@superclasses, 'Foo6::SuperClass::After::Attribute');
	270
53a4d826	271	::throws_ok {
590e8894	272	extends @superclasses;
53a4d826	273	} qr/compat.*pristine/,
590e8894	274	'unsafe MI extends after_generated_methods with metaclass roles';
53a4d826	275	::throws_ok {
590e8894	276	extends reverse @superclasses;
53a4d826	277	} qr/compat.*pristine/,
590e8894	278	'unsafe MI extends after_generated_methods with metaclass roles (reverse)';
	279	}
	280
38bf6bf3	281	{
	282	package Foo7::Meta::Trait;
	283	use Moose::Role;
	284	}
	285
	286	{
	287	package Foo7;
	288	use Moose -traits => ['Foo7::Meta::Trait'];
	289	}
	290
	291	{
	292	package Bar7;
	293	# in an external file
	294	use Moose -traits => ['Bar7::Meta::Trait'];
53a4d826	295	::lives_ok { extends 'Foo7' } "role reconciliation works";
38bf6bf3	296	}
	297
	298	{
	299	package Bar72;
	300	# in an external file
	301	use Moose -traits => ['Bar7::Meta::Trait2'];
53a4d826	302	::lives_ok { extends 'Foo7' } "role reconciliation works";
38bf6bf3	303	}
38bf6bf3	304
6d6d2327	305	done_testing;