[gitmo/Class-MOP.git] / t / 070_immutable_metaclass.t

#!/usr/bin/perl

use strict;
use warnings;

use Test::More tests => 80;
use Test::Exception;

BEGIN {
    use_ok('Class::MOP');
    use_ok('Class::MOP::Class::Immutable');    
}

{
    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;
    is($meta->name, 'Foo', '... checking the Foo metaclass');
    
    ok($meta->is_mutable, '... our class is mutable');
    ok(!$meta->is_immutable, '... our class is not immutable');    

    lives_ok {
        $meta->make_immutable();
    } '... changed Foo to be immutable';
    
    ok(!$meta->make_immutable, '... make immutable now returns nothing');
    
    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::Immutable');
    isa_ok($meta, 'Class::MOP::Class');

    dies_ok { $meta->reinitialize() } '... exception thrown as expected';
    
    dies_ok { $meta->add_method()    } '... exception thrown as expected';
    dies_ok { $meta->alias_method()  } '... exception thrown as expected';
    dies_ok { $meta->remove_method() } '... exception thrown as expected';
    
    dies_ok { $meta->add_attribute()    } '... exception thrown as expected';
    dies_ok { $meta->remove_attribute() } '... exception thrown as expected';
                        
    dies_ok { $meta->add_package_symbol()    } '... exception thrown as expected';
    dies_ok { $meta->remove_package_symbol() } '... exception thrown as expected';

    my @supers;
    lives_ok {
        @supers = $meta->superclasses;
    } '... got the superclasses okay';

    dies_ok { $meta->superclasses([ 'UNIVERSAL' ]) } '... but could not set the superclasses okay';
    
    my $meta_instance;
    lives_ok {
        $meta_instance = $meta->get_meta_instance;
    } '... 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;
    lives_ok {
        @cpl = $meta->class_precedence_list;
    } '... got the class precedence list okay';    
    is_deeply(
    \@cpl,
    [ 'Foo' ],
    '... we just have ourselves in the class precedence list');
    
    my @attributes;
    lives_ok {
        @attributes = $meta->compute_all_applicable_attributes;
    } '... 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');    

    lives_ok {
        $meta->make_immutable();
    } '... changed Bar to be immutable';
    
    ok(!$meta->make_immutable, '... make immutable now returns nothing');
    
    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::Immutable');
    isa_ok($meta, 'Class::MOP::Class');

    dies_ok { $meta->reinitialize() } '... exception thrown as expected';
    
    dies_ok { $meta->add_method()    } '... exception thrown as expected';
    dies_ok { $meta->alias_method()  } '... exception thrown as expected';
    dies_ok { $meta->remove_method() } '... exception thrown as expected';
    
    dies_ok { $meta->add_attribute()    } '... exception thrown as expected';
    dies_ok { $meta->remove_attribute() } '... exception thrown as expected';
                        
    dies_ok { $meta->add_package_symbol()    } '... exception thrown as expected';
    dies_ok { $meta->remove_package_symbol() } '... exception thrown as expected';

    my @supers;
    lives_ok {
        @supers = $meta->superclasses;
    } '... got the superclasses okay';

    dies_ok { $meta->superclasses([ 'UNIVERSAL' ]) } '... but could not set the superclasses okay';
    
    my $meta_instance;
    lives_ok {
        $meta_instance = $meta->get_meta_instance;
    } '... 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;
    lives_ok {
        @cpl = $meta->class_precedence_list;
    } '... got the class precedence list okay';    
    is_deeply(
    \@cpl,
    [ 'Bar', 'Foo'],
    '... we just have ourselves in the class precedence list');
    
    my @attributes;
    lives_ok {
        @attributes = $meta->compute_all_applicable_attributes;
    } '... 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');    

    lives_ok {
        $meta->make_immutable();
    } '... changed Baz to be immutable';
    
    ok(!$meta->make_immutable, '... make immutable now returns nothing');
    
    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::Immutable');
    isa_ok($meta, 'Class::MOP::Class');

    dies_ok { $meta->reinitialize() } '... exception thrown as expected';
    
    dies_ok { $meta->add_method()    } '... exception thrown as expected';
    dies_ok { $meta->alias_method()  } '... exception thrown as expected';
    dies_ok { $meta->remove_method() } '... exception thrown as expected';
    
    dies_ok { $meta->add_attribute()    } '... exception thrown as expected';
    dies_ok { $meta->remove_attribute() } '... exception thrown as expected';
                        
    dies_ok { $meta->add_package_symbol()    } '... exception thrown as expected';
    dies_ok { $meta->remove_package_symbol() } '... exception thrown as expected';

    my @supers;
    lives_ok {
        @supers = $meta->superclasses;
    } '... got the superclasses okay';

    dies_ok { $meta->superclasses([ 'UNIVERSAL' ]) } '... but could not set the superclasses okay';
    
    my $meta_instance;
    lives_ok {
        $meta_instance = $meta->get_meta_instance;
    } '... 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;
    lives_ok {
        @cpl = $meta->class_precedence_list;
    } '... got the class precedence list okay';    
    is_deeply(
    \@cpl,
    [ 'Baz', 'Bar', 'Foo'],
    '... we just have ourselves in the class precedence list');
    
    my @attributes;
    lives_ok {
        @attributes = $meta->compute_all_applicable_attributes;
    } '... 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');
}
Commit	Line	Data
857f87a7	1	#!/usr/bin/perl
	2
	3	use strict;
	4	use warnings;
	5
	6	use Test::More tests => 80;
	7	use Test::Exception;
	8
	9	BEGIN {
	10	use_ok('Class::MOP');
	11	use_ok('Class::MOP::Class::Immutable');
	12	}
	13
	14	{
	15	package Foo;
	16
	17	use strict;
	18	use warnings;
	19	use metaclass;
	20
	21	__PACKAGE__->meta->add_attribute('bar');
	22
	23	package Bar;
	24
	25	use strict;
	26	use warnings;
	27	use metaclass;
	28
	29	__PACKAGE__->meta->superclasses('Foo');
	30
	31	__PACKAGE__->meta->add_attribute('baz');
	32
	33	package Baz;
	34
	35	use strict;
	36	use warnings;
	37	use metaclass;
	38
	39	__PACKAGE__->meta->superclasses('Bar');
	40
	41	__PACKAGE__->meta->add_attribute('bah');
	42	}
	43
	44	{
	45	my $meta = Foo->meta;
	46	is($meta->name, 'Foo', '... checking the Foo metaclass');
	47
	48	ok($meta->is_mutable, '... our class is mutable');
	49	ok(!$meta->is_immutable, '... our class is not immutable');
	50
	51	lives_ok {
	52	$meta->make_immutable();
	53	} '... changed Foo to be immutable';
	54
	55	ok(!$meta->make_immutable, '... make immutable now returns nothing');
	56
	57	ok(!$meta->is_mutable, '... our class is no longer mutable');
	58	ok($meta->is_immutable, '... our class is now immutable');
	59
	60	isa_ok($meta, 'Class::MOP::Class::Immutable');
	61	isa_ok($meta, 'Class::MOP::Class');
	62
	63	dies_ok { $meta->reinitialize() } '... exception thrown as expected';
	64
65	dies_ok { $meta->add_method() } '... exception thrown as expected';
66	dies_ok { $meta->alias_method() } '... exception thrown as expected';
67	dies_ok { $meta->remove_method() } '... exception thrown as expected';
68
69	dies_ok { $meta->add_attribute() } '... exception thrown as expected';
70	dies_ok { $meta->remove_attribute() } '... exception thrown as expected';
71
58d75218	72	dies_ok { $meta->add_package_symbol() } '... exception thrown as expected';
58d75218	73	dies_ok { $meta->remove_package_symbol() } '... exception thrown as expected';
857f87a7	74
	75	my @supers;
	76	lives_ok {
	77	@supers = $meta->superclasses;
	78	} '... got the superclasses okay';
	79
	80	dies_ok { $meta->superclasses([ 'UNIVERSAL' ]) } '... but could not set the superclasses okay';
	81
	82	my $meta_instance;
	83	lives_ok {
	84	$meta_instance = $meta->get_meta_instance;
	85	} '... got the meta instance okay';
	86	isa_ok($meta_instance, 'Class::MOP::Instance');
	87	is($meta_instance, $meta->get_meta_instance, '... and we know it is cached');
	88
	89	my @cpl;
	90	lives_ok {
	91	@cpl = $meta->class_precedence_list;
	92	} '... got the class precedence list okay';
	93	is_deeply(
	94	\@cpl,
	95	[ 'Foo' ],
	96	'... we just have ourselves in the class precedence list');
	97
	98	my @attributes;
	99	lives_ok {
	100	@attributes = $meta->compute_all_applicable_attributes;
	101	} '... got the attribute list okay';
	102	is_deeply(
	103	\@attributes,
	104	[ $meta->get_attribute('bar') ],
	105	'... got the right list of attributes');
	106	}
	107
	108	{
	109	my $meta = Bar->meta;
	110	is($meta->name, 'Bar', '... checking the Bar metaclass');
	111
	112	ok($meta->is_mutable, '... our class is mutable');
	113	ok(!$meta->is_immutable, '... our class is not immutable');
	114
	115	lives_ok {
	116	$meta->make_immutable();
	117	} '... changed Bar to be immutable';
	118
	119	ok(!$meta->make_immutable, '... make immutable now returns nothing');
	120
	121	ok(!$meta->is_mutable, '... our class is no longer mutable');
	122	ok($meta->is_immutable, '... our class is now immutable');
	123
	124	isa_ok($meta, 'Class::MOP::Class::Immutable');
	125	isa_ok($meta, 'Class::MOP::Class');
	126
	127	dies_ok { $meta->reinitialize() } '... exception thrown as expected';
	128
	129	dies_ok { $meta->add_method() } '... exception thrown as expected';
	130	dies_ok { $meta->alias_method() } '... exception thrown as expected';
	131	dies_ok { $meta->remove_method() } '... exception thrown as expected';
	132
	133	dies_ok { $meta->add_attribute() } '... exception thrown as expected';
	134	dies_ok { $meta->remove_attribute() } '... exception thrown as expected';
	135
58d75218	136	dies_ok { $meta->add_package_symbol() } '... exception thrown as expected';
58d75218	137	dies_ok { $meta->remove_package_symbol() } '... exception thrown as expected';
857f87a7	138
	139	my @supers;
	140	lives_ok {
	141	@supers = $meta->superclasses;
	142	} '... got the superclasses okay';
	143
	144	dies_ok { $meta->superclasses([ 'UNIVERSAL' ]) } '... but could not set the superclasses okay';
	145
	146	my $meta_instance;
	147	lives_ok {
	148	$meta_instance = $meta->get_meta_instance;
	149	} '... got the meta instance okay';
	150	isa_ok($meta_instance, 'Class::MOP::Instance');
	151	is($meta_instance, $meta->get_meta_instance, '... and we know it is cached');
	152
	153	my @cpl;
	154	lives_ok {
	155	@cpl = $meta->class_precedence_list;
	156	} '... got the class precedence list okay';
	157	is_deeply(
	158	\@cpl,
	159	[ 'Bar', 'Foo'],
	160	'... we just have ourselves in the class precedence list');
	161
	162	my @attributes;
	163	lives_ok {
	164	@attributes = $meta->compute_all_applicable_attributes;
	165	} '... got the attribute list okay';
	166	is_deeply(
	167	[ sort { $a->name cmp $b->name } @attributes ],
	168	[ Foo->meta->get_attribute('bar'), $meta->get_attribute('baz') ],
	169	'... got the right list of attributes');
	170	}
	171
	172	{
	173	my $meta = Baz->meta;
	174	is($meta->name, 'Baz', '... checking the Baz metaclass');
	175
	176	ok($meta->is_mutable, '... our class is mutable');
	177	ok(!$meta->is_immutable, '... our class is not immutable');
	178
	179	lives_ok {
	180	$meta->make_immutable();
	181	} '... changed Baz to be immutable';
	182
	183	ok(!$meta->make_immutable, '... make immutable now returns nothing');
	184
	185	ok(!$meta->is_mutable, '... our class is no longer mutable');
	186	ok($meta->is_immutable, '... our class is now immutable');
	187
	188	isa_ok($meta, 'Class::MOP::Class::Immutable');
	189	isa_ok($meta, 'Class::MOP::Class');
	190
	191	dies_ok { $meta->reinitialize() } '... exception thrown as expected';
	192
	193	dies_ok { $meta->add_method() } '... exception thrown as expected';
	194	dies_ok { $meta->alias_method() } '... exception thrown as expected';
	195	dies_ok { $meta->remove_method() } '... exception thrown as expected';
	196
	197	dies_ok { $meta->add_attribute() } '... exception thrown as expected';
	198	dies_ok { $meta->remove_attribute() } '... exception thrown as expected';
	199
58d75218	200	dies_ok { $meta->add_package_symbol() } '... exception thrown as expected';
58d75218	201	dies_ok { $meta->remove_package_symbol() } '... exception thrown as expected';
857f87a7	202
	203	my @supers;
	204	lives_ok {
	205	@supers = $meta->superclasses;
	206	} '... got the superclasses okay';
	207
	208	dies_ok { $meta->superclasses([ 'UNIVERSAL' ]) } '... but could not set the superclasses okay';
	209
	210	my $meta_instance;
	211	lives_ok {
	212	$meta_instance = $meta->get_meta_instance;
	213	} '... got the meta instance okay';
	214	isa_ok($meta_instance, 'Class::MOP::Instance');
	215	is($meta_instance, $meta->get_meta_instance, '... and we know it is cached');
	216
	217	my @cpl;
	218	lives_ok {
	219	@cpl = $meta->class_precedence_list;
	220	} '... got the class precedence list okay';
	221	is_deeply(
	222	\@cpl,
	223	[ 'Baz', 'Bar', 'Foo'],
	224	'... we just have ourselves in the class precedence list');
	225
	226	my @attributes;
	227	lives_ok {
	228	@attributes = $meta->compute_all_applicable_attributes;
	229	} '... got the attribute list okay';
	230	is_deeply(
	231	[ sort { $a->name cmp $b->name } @attributes ],
	232	[ $meta->get_attribute('bah'), Foo->meta->get_attribute('bar'), Bar->meta->get_attribute('baz') ],
	233	'... got the right list of attributes');
	234	}
	235
	236