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