[gitmo/Moose.git] / t / cmop / immutable_metaclass.t

use strict;
use warnings;

use Test::More;
use Test::Fatal;

use Class::MOP;

{
    package Foo;

    use strict;
    use warnings;
    use metaclass;

    __PACKAGE__->meta->add_attribute('bar');

    package Bar;

    use strict;
    use warnings;
    use metaclass;

    __PACKAGE__->meta->superclasses('Foo');

    __PACKAGE__->meta->add_attribute('baz');

    package Baz;

    use strict;
    use warnings;
    use metaclass;

    __PACKAGE__->meta->superclasses('Bar');

    __PACKAGE__->meta->add_attribute('bah');
}

{
    my $meta = Foo->meta;
    my $original_metaclass_name = ref $meta;

    is_deeply(
        { $meta->immutable_options }, {},
        'immutable_options is empty before a class is made_immutable'
    );

    ok( $meta->make_immutable, 'make_immutable returns true' );
    my $line = __LINE__ - 1;

    ok( $meta->make_immutable, 'make_immutable still returns true' );

    my $immutable_metaclass = $meta->_immutable_metaclass->meta;

    my $immutable_class_name = $immutable_metaclass->name;

    ok( !$immutable_class_name->is_mutable,  '... immutable_metaclass is not mutable' );
    ok( $immutable_class_name->is_immutable, '... immutable_metaclass is immutable' );
    is( $immutable_class_name->meta, $immutable_metaclass,
        '... immutable_metaclass meta hack works' );

    is_deeply(
        { $meta->immutable_options },
        {
            inline_accessors   => 1,
            inline_constructor => 1,
            inline_destructor  => 0,
            debug              => 0,
            immutable_trait    => 'Class::MOP::Class::Immutable::Trait',
            constructor_name   => 'new',
            constructor_class  => 'Class::MOP::Method::Constructor',
            destructor_class   => undef,
            file               => $0,
            line               => $line,
        },
        'immutable_options is empty before a class is made_immutable'
    );

    isa_ok( $meta, "Class::MOP::Class" );
}

{
    my $meta = Foo->meta;
    is( $meta->name, 'Foo', '... checking the Foo metaclass' );

    ok( !$meta->is_mutable,    '... our class is not mutable' );
    ok( $meta->is_immutable, '... our class is immutable' );

    isa_ok( $meta, 'Class::MOP::Class' );

    isnt( exception { $meta->add_method() }, undef, '... exception thrown as expected' );
    isnt( exception { $meta->alias_method() }, undef, '... exception thrown as expected' );
    isnt( exception { $meta->remove_method() }, undef, '... exception thrown as expected' );

    isnt( exception { $meta->add_attribute() }, undef, '... exception thrown as expected' );
    isnt( exception { $meta->remove_attribute() }, undef, '... exception thrown as expected' );

    isnt( exception { $meta->add_package_symbol() }, undef, '... exception thrown as expected' );
    isnt( exception { $meta->remove_package_symbol() }, undef, '... exception thrown as expected' );

    is( exception { $meta->identifier() }, undef, '... no exception for get_package_symbol special case' );

    my @supers;
    is( exception {
        @supers = $meta->superclasses;
    }, undef, '... got the superclasses okay' );

    isnt( exception { $meta->superclasses( ['UNIVERSAL'] ) }, undef, '... but could not set the superclasses okay' );

    my $meta_instance;
    is( exception {
        $meta_instance = $meta->get_meta_instance;
    }, undef, '... got the meta instance okay' );
    isa_ok( $meta_instance, 'Class::MOP::Instance' );
    is( $meta_instance, $meta->get_meta_instance,
        '... and we know it is cached' );

    my @cpl;
    is( exception {
        @cpl = $meta->class_precedence_list;
    }, undef, '... got the class precedence list okay' );
    is_deeply(
        \@cpl,
        ['Foo'],
        '... we just have ourselves in the class precedence list'
    );

    my @attributes;
    is( exception {
        @attributes = $meta->get_all_attributes;
    }, undef, '... got the attribute list okay' );
    is_deeply(
        \@attributes,
        [ $meta->get_attribute('bar') ],
        '... got the right list of attributes'
    );
}

{
    my $meta = Bar->meta;
    is( $meta->name, 'Bar', '... checking the Bar metaclass' );

    ok( $meta->is_mutable,    '... our class is mutable' );
    ok( !$meta->is_immutable, '... our class is not immutable' );

    is( exception {
        $meta->make_immutable();
    }, undef, '... changed Bar to be immutable' );

    ok( $meta->make_immutable, '... make immutable returns true' );

    ok( !$meta->is_mutable,  '... our class is no longer mutable' );
    ok( $meta->is_immutable, '... our class is now immutable' );

    isa_ok( $meta, 'Class::MOP::Class' );

    isnt( exception { $meta->add_method() }, undef, '... exception thrown as expected' );
    isnt( exception { $meta->alias_method() }, undef, '... exception thrown as expected' );
    isnt( exception { $meta->remove_method() }, undef, '... exception thrown as expected' );

    isnt( exception { $meta->add_attribute() }, undef, '... exception thrown as expected' );
    isnt( exception { $meta->remove_attribute() }, undef, '... exception thrown as expected' );

    isnt( exception { $meta->add_package_symbol() }, undef, '... exception thrown as expected' );
    isnt( exception { $meta->remove_package_symbol() }, undef, '... exception thrown as expected' );

    my @supers;
    is( exception {
        @supers = $meta->superclasses;
    }, undef, '... got the superclasses okay' );

    isnt( exception { $meta->superclasses( ['UNIVERSAL'] ) }, undef, '... but could not set the superclasses okay' );

    my $meta_instance;
    is( exception {
        $meta_instance = $meta->get_meta_instance;
    }, undef, '... got the meta instance okay' );
    isa_ok( $meta_instance, 'Class::MOP::Instance' );
    is( $meta_instance, $meta->get_meta_instance,
        '... and we know it is cached' );

    my @cpl;
    is( exception {
        @cpl = $meta->class_precedence_list;
    }, undef, '... got the class precedence list okay' );
    is_deeply(
        \@cpl,
        [ 'Bar', 'Foo' ],
        '... we just have ourselves in the class precedence list'
    );

    my @attributes;
    is( exception {
        @attributes = $meta->get_all_attributes;
    }, undef, '... got the attribute list okay' );
    is_deeply(
        [ sort { $a->name cmp $b->name } @attributes ],
        [ Foo->meta->get_attribute('bar'), $meta->get_attribute('baz') ],
        '... got the right list of attributes'
    );
}

{
    my $meta = Baz->meta;
    is( $meta->name, 'Baz', '... checking the Baz metaclass' );

    ok( $meta->is_mutable,    '... our class is mutable' );
    ok( !$meta->is_immutable, '... our class is not immutable' );

    is( exception {
        $meta->make_immutable();
    }, undef, '... changed Baz to be immutable' );

    ok( $meta->make_immutable, '... make immutable returns true' );

    ok( !$meta->is_mutable,  '... our class is no longer mutable' );
    ok( $meta->is_immutable, '... our class is now immutable' );

    isa_ok( $meta, 'Class::MOP::Class' );

    isnt( exception { $meta->add_method() }, undef, '... exception thrown as expected' );
    isnt( exception { $meta->alias_method() }, undef, '... exception thrown as expected' );
    isnt( exception { $meta->remove_method() }, undef, '... exception thrown as expected' );

    isnt( exception { $meta->add_attribute() }, undef, '... exception thrown as expected' );
    isnt( exception { $meta->remove_attribute() }, undef, '... exception thrown as expected' );

    isnt( exception { $meta->add_package_symbol() }, undef, '... exception thrown as expected' );
    isnt( exception { $meta->remove_package_symbol() }, undef, '... exception thrown as expected' );

    my @supers;
    is( exception {
        @supers = $meta->superclasses;
    }, undef, '... got the superclasses okay' );

    isnt( exception { $meta->superclasses( ['UNIVERSAL'] ) }, undef, '... but could not set the superclasses okay' );

    my $meta_instance;
    is( exception {
        $meta_instance = $meta->get_meta_instance;
    }, undef, '... got the meta instance okay' );
    isa_ok( $meta_instance, 'Class::MOP::Instance' );
    is( $meta_instance, $meta->get_meta_instance,
        '... and we know it is cached' );

    my @cpl;
    is( exception {
        @cpl = $meta->class_precedence_list;
    }, undef, '... got the class precedence list okay' );
    is_deeply(
        \@cpl,
        [ 'Baz', 'Bar', 'Foo' ],
        '... we just have ourselves in the class precedence list'
    );

    my @attributes;
    is( exception {
        @attributes = $meta->get_all_attributes;
    }, undef, '... got the attribute list okay' );
    is_deeply(
        [ sort { $a->name cmp $b->name } @attributes ],
        [
            $meta->get_attribute('bah'), Foo->meta->get_attribute('bar'),
            Bar->meta->get_attribute('baz')
        ],
        '... got the right list of attributes'
    );
}

# This test probably needs to go last since it will muck up the Foo class
{
    my $meta = Foo->meta;

    $meta->make_mutable;
    $meta->make_immutable(
        inline_accessors   => 0,
        inline_constructor => 0,
        constructor_name   => 'newer',
    );
    my $line = __LINE__ - 5;

    is_deeply(
        { $meta->immutable_options },
        {
            inline_accessors   => 0,
            inline_constructor => 0,
            inline_destructor  => 0,
            debug              => 0,
            immutable_trait    => 'Class::MOP::Class::Immutable::Trait',
            constructor_name   => 'newer',
            constructor_class  => 'Class::MOP::Method::Constructor',
            destructor_class   => undef,
            file               => $0,
            line               => $line,
        },
        'custom immutable_options are returned by immutable_options accessor'
    );
}

done_testing;
Commit	Line	Data
38bf2a25	1	use strict;
	2	use warnings;
	3
	4	use Test::More;
	5	use Test::Fatal;
	6
	7	use Class::MOP;
	8
	9	{
	10	package Foo;
	11
	12	use strict;
	13	use warnings;
	14	use metaclass;
	15
	16	__PACKAGE__->meta->add_attribute('bar');
	17
	18	package Bar;
	19
	20	use strict;
	21	use warnings;
	22	use metaclass;
	23
	24	__PACKAGE__->meta->superclasses('Foo');
	25
	26	__PACKAGE__->meta->add_attribute('baz');
	27
	28	package Baz;
	29
	30	use strict;
	31	use warnings;
	32	use metaclass;
	33
	34	__PACKAGE__->meta->superclasses('Bar');
	35
	36	__PACKAGE__->meta->add_attribute('bah');
	37	}
	38
	39	{
	40	my $meta = Foo->meta;
	41	my $original_metaclass_name = ref $meta;
	42
	43	is_deeply(
	44	{ $meta->immutable_options }, {},
	45	'immutable_options is empty before a class is made_immutable'
	46	);
	47
b20483ff	48	ok( $meta->make_immutable, 'make_immutable returns true' );
00b7f207	49	my $line = __LINE__ - 1;
38bf2a25	50
b20483ff	51	ok( $meta->make_immutable, 'make_immutable still returns true' );
662fdff2	52
38bf2a25	53	my $immutable_metaclass = $meta->_immutable_metaclass->meta;
	54
	55	my $immutable_class_name = $immutable_metaclass->name;
	56
	57	ok( !$immutable_class_name->is_mutable, '... immutable_metaclass is not mutable' );
	58	ok( $immutable_class_name->is_immutable, '... immutable_metaclass is immutable' );
	59	is( $immutable_class_name->meta, $immutable_metaclass,
	60	'... immutable_metaclass meta hack works' );
	61
	62	is_deeply(
	63	{ $meta->immutable_options },
	64	{
	65	inline_accessors => 1,
	66	inline_constructor => 1,
	67	inline_destructor => 0,
	68	debug => 0,
	69	immutable_trait => 'Class::MOP::Class::Immutable::Trait',
	70	constructor_name => 'new',
	71	constructor_class => 'Class::MOP::Method::Constructor',
	72	destructor_class => undef,
00b7f207	73	file => $0,
00b7f207	74	line => $line,
38bf2a25	75	},
	76	'immutable_options is empty before a class is made_immutable'
	77	);
	78
	79	isa_ok( $meta, "Class::MOP::Class" );
	80	}
	81
	82	{
	83	my $meta = Foo->meta;
	84	is( $meta->name, 'Foo', '... checking the Foo metaclass' );
	85
	86	ok( !$meta->is_mutable, '... our class is not mutable' );
	87	ok( $meta->is_immutable, '... our class is immutable' );
	88
	89	isa_ok( $meta, 'Class::MOP::Class' );
	90
	91	isnt( exception { $meta->add_method() }, undef, '... exception thrown as expected' );
	92	isnt( exception { $meta->alias_method() }, undef, '... exception thrown as expected' );
	93	isnt( exception { $meta->remove_method() }, undef, '... exception thrown as expected' );
	94
	95	isnt( exception { $meta->add_attribute() }, undef, '... exception thrown as expected' );
	96	isnt( exception { $meta->remove_attribute() }, undef, '... exception thrown as expected' );
	97
	98	isnt( exception { $meta->add_package_symbol() }, undef, '... exception thrown as expected' );
	99	isnt( exception { $meta->remove_package_symbol() }, undef, '... exception thrown as expected' );
	100
	101	is( exception { $meta->identifier() }, undef, '... no exception for get_package_symbol special case' );
	102
	103	my @supers;
	104	is( exception {
	105	@supers = $meta->superclasses;
	106	}, undef, '... got the superclasses okay' );
	107
	108	isnt( exception { $meta->superclasses( ['UNIVERSAL'] ) }, undef, '... but could not set the superclasses okay' );
	109
	110	my $meta_instance;
	111	is( exception {
	112	$meta_instance = $meta->get_meta_instance;
	113	}, undef, '... got the meta instance okay' );
	114	isa_ok( $meta_instance, 'Class::MOP::Instance' );
	115	is( $meta_instance, $meta->get_meta_instance,
	116	'... and we know it is cached' );
	117
	118	my @cpl;
	119	is( exception {
	120	@cpl = $meta->class_precedence_list;
	121	}, undef, '... got the class precedence list okay' );
	122	is_deeply(
	123	\@cpl,
	124	['Foo'],
	125	'... we just have ourselves in the class precedence list'
	126	);
	127
	128	my @attributes;
	129	is( exception {
	130	@attributes = $meta->get_all_attributes;
	131	}, undef, '... got the attribute list okay' );
	132	is_deeply(
	133	\@attributes,
	134	[ $meta->get_attribute('bar') ],
	135	'... got the right list of attributes'
	136	);
	137	}
	138
139	{
140	my $meta = Bar->meta;
141	is( $meta->name, 'Bar', '... checking the Bar metaclass' );
142
143	ok( $meta->is_mutable, '... our class is mutable' );
144	ok( !$meta->is_immutable, '... our class is not immutable' );
145
146	is( exception {
147	$meta->make_immutable();
148	}, undef, '... changed Bar to be immutable' );
149
b20483ff	150	ok( $meta->make_immutable, '... make immutable returns true' );
38bf2a25	151
	152	ok( !$meta->is_mutable, '... our class is no longer mutable' );
	153	ok( $meta->is_immutable, '... our class is now immutable' );
	154
	155	isa_ok( $meta, 'Class::MOP::Class' );
	156
	157	isnt( exception { $meta->add_method() }, undef, '... exception thrown as expected' );
	158	isnt( exception { $meta->alias_method() }, undef, '... exception thrown as expected' );
	159	isnt( exception { $meta->remove_method() }, undef, '... exception thrown as expected' );
	160
	161	isnt( exception { $meta->add_attribute() }, undef, '... exception thrown as expected' );
	162	isnt( exception { $meta->remove_attribute() }, undef, '... exception thrown as expected' );
	163
	164	isnt( exception { $meta->add_package_symbol() }, undef, '... exception thrown as expected' );
	165	isnt( exception { $meta->remove_package_symbol() }, undef, '... exception thrown as expected' );
	166
	167	my @supers;
	168	is( exception {
	169	@supers = $meta->superclasses;
	170	}, undef, '... got the superclasses okay' );
	171
	172	isnt( exception { $meta->superclasses( ['UNIVERSAL'] ) }, undef, '... but could not set the superclasses okay' );
	173
	174	my $meta_instance;
	175	is( exception {
	176	$meta_instance = $meta->get_meta_instance;
	177	}, undef, '... got the meta instance okay' );
	178	isa_ok( $meta_instance, 'Class::MOP::Instance' );
	179	is( $meta_instance, $meta->get_meta_instance,
	180	'... and we know it is cached' );
	181
	182	my @cpl;
	183	is( exception {
	184	@cpl = $meta->class_precedence_list;
	185	}, undef, '... got the class precedence list okay' );
	186	is_deeply(
	187	\@cpl,
	188	[ 'Bar', 'Foo' ],
	189	'... we just have ourselves in the class precedence list'
	190	);
	191
	192	my @attributes;
	193	is( exception {
	194	@attributes = $meta->get_all_attributes;
	195	}, undef, '... got the attribute list okay' );
	196	is_deeply(
	197	[ sort { $a->name cmp $b->name } @attributes ],
	198	[ Foo->meta->get_attribute('bar'), $meta->get_attribute('baz') ],
	199	'... got the right list of attributes'
	200	);
	201	}
	202
	203	{
	204	my $meta = Baz->meta;
	205	is( $meta->name, 'Baz', '... checking the Baz metaclass' );
	206
	207	ok( $meta->is_mutable, '... our class is mutable' );
	208	ok( !$meta->is_immutable, '... our class is not immutable' );
	209
	210	is( exception {
	211	$meta->make_immutable();
	212	}, undef, '... changed Baz to be immutable' );
	213
b20483ff	214	ok( $meta->make_immutable, '... make immutable returns true' );
38bf2a25	215
	216	ok( !$meta->is_mutable, '... our class is no longer mutable' );
	217	ok( $meta->is_immutable, '... our class is now immutable' );
	218
	219	isa_ok( $meta, 'Class::MOP::Class' );
	220
	221	isnt( exception { $meta->add_method() }, undef, '... exception thrown as expected' );
	222	isnt( exception { $meta->alias_method() }, undef, '... exception thrown as expected' );
	223	isnt( exception { $meta->remove_method() }, undef, '... exception thrown as expected' );
	224
	225	isnt( exception { $meta->add_attribute() }, undef, '... exception thrown as expected' );
	226	isnt( exception { $meta->remove_attribute() }, undef, '... exception thrown as expected' );
	227
	228	isnt( exception { $meta->add_package_symbol() }, undef, '... exception thrown as expected' );
	229	isnt( exception { $meta->remove_package_symbol() }, undef, '... exception thrown as expected' );
	230
	231	my @supers;
	232	is( exception {
	233	@supers = $meta->superclasses;
	234	}, undef, '... got the superclasses okay' );
	235
	236	isnt( exception { $meta->superclasses( ['UNIVERSAL'] ) }, undef, '... but could not set the superclasses okay' );
	237
	238	my $meta_instance;
	239	is( exception {
	240	$meta_instance = $meta->get_meta_instance;
	241	}, undef, '... got the meta instance okay' );
	242	isa_ok( $meta_instance, 'Class::MOP::Instance' );
	243	is( $meta_instance, $meta->get_meta_instance,
	244	'... and we know it is cached' );
	245
	246	my @cpl;
	247	is( exception {
	248	@cpl = $meta->class_precedence_list;
	249	}, undef, '... got the class precedence list okay' );
	250	is_deeply(
	251	\@cpl,
	252	[ 'Baz', 'Bar', 'Foo' ],
	253	'... we just have ourselves in the class precedence list'
	254	);
	255
	256	my @attributes;
	257	is( exception {
	258	@attributes = $meta->get_all_attributes;
	259	}, undef, '... got the attribute list okay' );
	260	is_deeply(
	261	[ sort { $a->name cmp $b->name } @attributes ],
	262	[
	263	$meta->get_attribute('bah'), Foo->meta->get_attribute('bar'),
	264	Bar->meta->get_attribute('baz')
	265	],
	266	'... got the right list of attributes'
	267	);
	268	}
	269
	270	# This test probably needs to go last since it will muck up the Foo class
	271	{
	272	my $meta = Foo->meta;
	273
	274	$meta->make_mutable;
	275	$meta->make_immutable(
	276	inline_accessors => 0,
	277	inline_constructor => 0,
	278	constructor_name => 'newer',
279	);
00b7f207	280	my $line = __LINE__ - 5;
38bf2a25	281
	282	is_deeply(
	283	{ $meta->immutable_options },
	284	{
	285	inline_accessors => 0,
	286	inline_constructor => 0,
	287	inline_destructor => 0,
	288	debug => 0,
	289	immutable_trait => 'Class::MOP::Class::Immutable::Trait',
	290	constructor_name => 'newer',
	291	constructor_class => 'Class::MOP::Method::Constructor',
	292	destructor_class => undef,
00b7f207	293	file => $0,
00b7f207	294	line => $line,
38bf2a25	295	},
	296	'custom immutable_options are returned by immutable_options accessor'
	297	);
	298	}
	299
	300	done_testing;