[gitmo/Class-MOP.git] / t / 072_immutable_w_constructors.t

#!/usr/bin/perl

use strict;
use warnings;

use Test::More tests => 73;
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' => (
        reader  => 'bar',
        default => 'BAR',
    ));
    
    package Bar;
    
    use strict;
    use warnings;
    use metaclass;
    
    __PACKAGE__->meta->superclasses('Foo');

    __PACKAGE__->meta->add_attribute('baz' => (
        reader  => 'baz',
        default => sub { 'BAZ' },
    ));    
    
    package Baz;
    
    use strict;
    use warnings;
    use metaclass;
    
    __PACKAGE__->meta->superclasses('Bar');

    __PACKAGE__->meta->add_attribute('bah' => (
        reader  => 'bah',
        default => 'BAH',
    ));    
}

{
    my $meta = Foo->meta;
    is($meta->name, 'Foo', '... checking the Foo metaclass');
    
    {
        my $bar_accessor = $meta->get_method('bar');
        isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
        isa_ok($bar_accessor, 'Class::MOP::Method');    
    
        ok(!$bar_accessor->is_inline, '... the bar accessor is not inlined');    
    }
    
    ok(!$meta->is_immutable, '... our class is not immutable');    

    lives_ok {
        $meta->make_immutable(
            inline_constructor => 1,
            inline_accessors   => 0,            
        );
    } '... changed Foo to be immutable';

    ok($meta->is_immutable, '... our class is now immutable');        
    isa_ok($meta, 'Class::MOP::Class');    
    
    # they made a constructor for us :)
    can_ok('Foo', 'new');
    
    {
        my $foo = Foo->new;
        isa_ok($foo, 'Foo');
        is($foo->bar, 'BAR', '... got the right default value');
    }
    
    {
        my $foo = Foo->new(bar => 'BAZ');
        isa_ok($foo, 'Foo');
        is($foo->bar, 'BAZ', '... got the right parameter value');
    }    

    # check out accessors too
    {
        my $bar_accessor = $meta->get_method('bar');
        isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
        isa_ok($bar_accessor, 'Class::MOP::Method');    
    
        ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined');    
    }
}

{
    my $meta = Bar->meta;
    is($meta->name, 'Bar', '... checking the Bar metaclass');
    
    {
        my $bar_accessor = $meta->find_method_by_name('bar');
        isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
        isa_ok($bar_accessor, 'Class::MOP::Method');    
    
        ok(!$bar_accessor->is_inline, '... the bar accessor is not inlined');  
        
        my $baz_accessor = $meta->get_method('baz');
        isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
        isa_ok($baz_accessor, 'Class::MOP::Method');    
    
        ok(!$baz_accessor->is_inline, '... the baz accessor is not inlined');          
    }
    
    ok(!$meta->is_immutable, '... our class is not immutable');    

    lives_ok {
        $meta->make_immutable(
            inline_constructor => 1,
            inline_accessors   => 1,     
        );
    } '... changed Bar to be immutable';

    ok($meta->is_immutable, '... our class is now immutable');        
    isa_ok($meta, 'Class::MOP::Class');    
    
    # they made a constructor for us :)
    can_ok('Bar', 'new');
    
    {
        my $bar = Bar->new;
        isa_ok($bar, 'Bar');
        is($bar->bar, 'BAR', '... got the right default value');
        is($bar->baz, 'BAZ', '... got the right default value');        
    }
    
    {
        my $bar = Bar->new(bar => 'BAZ!', baz => 'BAR!');
        isa_ok($bar, 'Bar');
        is($bar->bar, 'BAZ!', '... got the right parameter value');
        is($bar->baz, 'BAR!', '... got the right parameter value');        
    }    

    # check out accessors too
    {
        my $bar_accessor = $meta->find_method_by_name('bar');
        isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
        isa_ok($bar_accessor, 'Class::MOP::Method');    
    
        ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined');    
        
        my $baz_accessor = $meta->get_method('baz');
        isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
        isa_ok($baz_accessor, 'Class::MOP::Method');    
    
        ok($baz_accessor->is_inline, '... the baz accessor is not inlined');        
    }
}

{
    my $meta = Baz->meta;
    is($meta->name, 'Baz', '... checking the Bar metaclass');
    
    {
        my $bar_accessor = $meta->find_method_by_name('bar');
        isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
        isa_ok($bar_accessor, 'Class::MOP::Method');    
    
        ok(!$bar_accessor->is_inline, '... the bar accessor is not inlined');  
        
        my $baz_accessor = $meta->find_method_by_name('baz');
        isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
        isa_ok($baz_accessor, 'Class::MOP::Method');    
    
        ok($baz_accessor->is_inline, '... the baz accessor is inlined');          
        
        my $bah_accessor = $meta->get_method('bah');
        isa_ok($bah_accessor, 'Class::MOP::Method::Accessor');
        isa_ok($bah_accessor, 'Class::MOP::Method');    
    
        ok(!$bah_accessor->is_inline, '... the baz accessor is not inlined');        
    }
    
    ok(!$meta->is_immutable, '... our class is not immutable');    

    lives_ok {
        $meta->make_immutable(
            inline_constructor => 0,
            inline_accessors   => 1,     
        );
    } '... changed Bar to be immutable';

    ok($meta->is_immutable, '... our class is now immutable');        
    isa_ok($meta, 'Class::MOP::Class');    
    
    ok(!Baz->meta->has_method('new'), '... no constructor was made');
    
    {
        my $baz = Baz->meta->construct_instance;
        isa_ok($baz, 'Bar');
        is($baz->bar, 'BAR', '... got the right default value');
        is($baz->baz, 'BAZ', '... got the right default value');        
    }
    
    {
        my $baz = Baz->meta->construct_instance(bar => 'BAZ!', baz => 'BAR!', bah => 'BAH!');
        isa_ok($baz, 'Baz');
        is($baz->bar, 'BAZ!', '... got the right parameter value');
        is($baz->baz, 'BAR!', '... got the right parameter value');
        is($baz->bah, 'BAH!', '... got the right parameter value');                
    }    

    # check out accessors too
    {
        my $bar_accessor = $meta->find_method_by_name('bar');
        isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
        isa_ok($bar_accessor, 'Class::MOP::Method');    
    
        ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined');    
        
        my $baz_accessor = $meta->find_method_by_name('baz');
        isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
        isa_ok($baz_accessor, 'Class::MOP::Method');    
    
        ok($baz_accessor->is_inline, '... the baz accessor is not inlined');  

        my $bah_accessor = $meta->get_method('bah');
        isa_ok($bah_accessor, 'Class::MOP::Method::Accessor');
        isa_ok($bah_accessor, 'Class::MOP::Method');    
    
        ok($bah_accessor->is_inline, '... the baz accessor is not inlined');        
    }
}
Commit	Line	Data
81c8a65b	1	#!/usr/bin/perl
	2
	3	use strict;
	4	use warnings;
	5
4d048908	6	use Test::More tests => 73;
81c8a65b	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	reader => 'bar',
	23	default => 'BAR',
	24	));
	25
	26	package Bar;
	27
	28	use strict;
	29	use warnings;
	30	use metaclass;
	31
	32	__PACKAGE__->meta->superclasses('Foo');
	33
	34	__PACKAGE__->meta->add_attribute('baz' => (
	35	reader => 'baz',
	36	default => sub { 'BAZ' },
	37	));
	38
	39	package Baz;
	40
	41	use strict;
	42	use warnings;
	43	use metaclass;
	44
	45	__PACKAGE__->meta->superclasses('Bar');
	46
	47	__PACKAGE__->meta->add_attribute('bah' => (
	48	reader => 'bah',
	49	default => 'BAH',
	50	));
	51	}
	52
	53	{
	54	my $meta = Foo->meta;
	55	is($meta->name, 'Foo', '... checking the Foo metaclass');
	56
	57	{
	58	my $bar_accessor = $meta->get_method('bar');
	59	isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
	60	isa_ok($bar_accessor, 'Class::MOP::Method');
	61
	62	ok(!$bar_accessor->is_inline, '... the bar accessor is not inlined');
	63	}
	64
	65	ok(!$meta->is_immutable, '... our class is not immutable');
	66
	67	lives_ok {
	68	$meta->make_immutable(
	69	inline_constructor => 1,
	70	inline_accessors => 0,
71	);
72	} '... changed Foo to be immutable';
73
74	ok($meta->is_immutable, '... our class is now immutable');
81c8a65b	75	isa_ok($meta, 'Class::MOP::Class');
	76
	77	# they made a constructor for us :)
	78	can_ok('Foo', 'new');
	79
	80	{
	81	my $foo = Foo->new;
	82	isa_ok($foo, 'Foo');
	83	is($foo->bar, 'BAR', '... got the right default value');
	84	}
	85
	86	{
	87	my $foo = Foo->new(bar => 'BAZ');
	88	isa_ok($foo, 'Foo');
	89	is($foo->bar, 'BAZ', '... got the right parameter value');
	90	}
	91
	92	# check out accessors too
	93	{
	94	my $bar_accessor = $meta->get_method('bar');
	95	isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
	96	isa_ok($bar_accessor, 'Class::MOP::Method');
	97
	98	ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined');
	99	}
	100	}
	101
	102	{
	103	my $meta = Bar->meta;
	104	is($meta->name, 'Bar', '... checking the Bar metaclass');
	105
	106	{
	107	my $bar_accessor = $meta->find_method_by_name('bar');
	108	isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
	109	isa_ok($bar_accessor, 'Class::MOP::Method');
	110
	111	ok(!$bar_accessor->is_inline, '... the bar accessor is not inlined');
	112
	113	my $baz_accessor = $meta->get_method('baz');
	114	isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
	115	isa_ok($baz_accessor, 'Class::MOP::Method');
	116
	117	ok(!$baz_accessor->is_inline, '... the baz accessor is not inlined');
	118	}
	119
	120	ok(!$meta->is_immutable, '... our class is not immutable');
	121
	122	lives_ok {
	123	$meta->make_immutable(
	124	inline_constructor => 1,
	125	inline_accessors => 1,
	126	);
	127	} '... changed Bar to be immutable';
	128
	129	ok($meta->is_immutable, '... our class is now immutable');
81c8a65b	130	isa_ok($meta, 'Class::MOP::Class');
	131
	132	# they made a constructor for us :)
	133	can_ok('Bar', 'new');
	134
	135	{
	136	my $bar = Bar->new;
	137	isa_ok($bar, 'Bar');
	138	is($bar->bar, 'BAR', '... got the right default value');
	139	is($bar->baz, 'BAZ', '... got the right default value');
	140	}
	141
	142	{
	143	my $bar = Bar->new(bar => 'BAZ!', baz => 'BAR!');
	144	isa_ok($bar, 'Bar');
	145	is($bar->bar, 'BAZ!', '... got the right parameter value');
	146	is($bar->baz, 'BAR!', '... got the right parameter value');
	147	}
	148
	149	# check out accessors too
	150	{
	151	my $bar_accessor = $meta->find_method_by_name('bar');
	152	isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
	153	isa_ok($bar_accessor, 'Class::MOP::Method');
	154
	155	ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined');
	156
	157	my $baz_accessor = $meta->get_method('baz');
	158	isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
	159	isa_ok($baz_accessor, 'Class::MOP::Method');
	160
	161	ok($baz_accessor->is_inline, '... the baz accessor is not inlined');
	162	}
	163	}
	164
	165	{
	166	my $meta = Baz->meta;
	167	is($meta->name, 'Baz', '... checking the Bar metaclass');
	168
	169	{
	170	my $bar_accessor = $meta->find_method_by_name('bar');
	171	isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
	172	isa_ok($bar_accessor, 'Class::MOP::Method');
	173
	174	ok(!$bar_accessor->is_inline, '... the bar accessor is not inlined');
	175
	176	my $baz_accessor = $meta->find_method_by_name('baz');
	177	isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
	178	isa_ok($baz_accessor, 'Class::MOP::Method');
	179
	180	ok($baz_accessor->is_inline, '... the baz accessor is inlined');
	181
	182	my $bah_accessor = $meta->get_method('bah');
	183	isa_ok($bah_accessor, 'Class::MOP::Method::Accessor');
	184	isa_ok($bah_accessor, 'Class::MOP::Method');
	185
	186	ok(!$bah_accessor->is_inline, '... the baz accessor is not inlined');
	187	}
	188
	189	ok(!$meta->is_immutable, '... our class is not immutable');
	190
	191	lives_ok {
	192	$meta->make_immutable(
	193	inline_constructor => 0,
194	inline_accessors => 1,
195	);
196	} '... changed Bar to be immutable';
197
198	ok($meta->is_immutable, '... our class is now immutable');
81c8a65b	199	isa_ok($meta, 'Class::MOP::Class');
	200
	201	ok(!Baz->meta->has_method('new'), '... no constructor was made');
	202
	203	{
	204	my $baz = Baz->meta->construct_instance;
	205	isa_ok($baz, 'Bar');
	206	is($baz->bar, 'BAR', '... got the right default value');
	207	is($baz->baz, 'BAZ', '... got the right default value');
	208	}
	209
	210	{
	211	my $baz = Baz->meta->construct_instance(bar => 'BAZ!', baz => 'BAR!', bah => 'BAH!');
	212	isa_ok($baz, 'Baz');
	213	is($baz->bar, 'BAZ!', '... got the right parameter value');
	214	is($baz->baz, 'BAR!', '... got the right parameter value');
	215	is($baz->bah, 'BAH!', '... got the right parameter value');
	216	}
	217
	218	# check out accessors too
	219	{
	220	my $bar_accessor = $meta->find_method_by_name('bar');
	221	isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
	222	isa_ok($bar_accessor, 'Class::MOP::Method');
	223
	224	ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined');
	225
	226	my $baz_accessor = $meta->find_method_by_name('baz');
	227	isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
	228	isa_ok($baz_accessor, 'Class::MOP::Method');
	229
	230	ok($baz_accessor->is_inline, '... the baz accessor is not inlined');
	231
	232	my $bah_accessor = $meta->get_method('bah');
	233	isa_ok($bah_accessor, 'Class::MOP::Method::Accessor');
	234	isa_ok($bah_accessor, 'Class::MOP::Method');
	235
	236	ok($bah_accessor->is_inline, '... the baz accessor is not inlined');
	237	}
	238	}
	239