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

    $meta->make_immutable;

    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,
        },
        '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 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' );

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

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

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