[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 $line = __LINE__ - 1;

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