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

#!/usr/bin/perl

use strict;
use warnings;

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

BEGIN {
    use_ok('Class::MOP');
    use_ok('Class::MOP::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');
    }   
    
    # NOTE:
    # check that the constructor correctly handles inheritance
    {
        my $bar = Bar->new();
        isa_ok($bar, 'Bar');
        isa_ok($bar, 'Foo');        
        is($bar->bar, 'BAR', '... got the right inherited parameter value');
        is($bar->baz, 'BAZ', '... got the right inherited 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
d90b42a6	1	#!/usr/bin/perl
	2
	3	use strict;
	4	use warnings;
	5
565f0cbb	6	use Test::More tests => 77;
d90b42a6	7	use Test::Exception;
	8
	9	BEGIN {
	10	use_ok('Class::MOP');
c23184fc	11	use_ok('Class::MOP::Immutable');
d90b42a6	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');
d90b42a6	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');
565f0cbb	90	}
	91
	92	# NOTE:
	93	# check that the constructor correctly handles inheritance
	94	{
	95	my $bar = Bar->new();
	96	isa_ok($bar, 'Bar');
	97	isa_ok($bar, 'Foo');
	98	is($bar->bar, 'BAR', '... got the right inherited parameter value');
	99	is($bar->baz, 'BAZ', '... got the right inherited parameter value');
d90b42a6	100	}
565f0cbb	101
d90b42a6	102	# check out accessors too
	103	{
	104	my $bar_accessor = $meta->get_method('bar');
	105	isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
	106	isa_ok($bar_accessor, 'Class::MOP::Method');
	107
	108	ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined');
	109	}
	110	}
	111
	112	{
	113	my $meta = Bar->meta;
	114	is($meta->name, 'Bar', '... checking the Bar metaclass');
	115
	116	{
	117	my $bar_accessor = $meta->find_method_by_name('bar');
	118	isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
	119	isa_ok($bar_accessor, 'Class::MOP::Method');
	120
	121	ok(!$bar_accessor->is_inline, '... the bar accessor is not inlined');
	122
	123	my $baz_accessor = $meta->get_method('baz');
	124	isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
	125	isa_ok($baz_accessor, 'Class::MOP::Method');
	126
	127	ok(!$baz_accessor->is_inline, '... the baz accessor is not inlined');
	128	}
	129
	130	ok(!$meta->is_immutable, '... our class is not immutable');
	131
	132	lives_ok {
	133	$meta->make_immutable(
	134	inline_constructor => 1,
	135	inline_accessors => 1,
	136	);
	137	} '... changed Bar to be immutable';
	138
	139	ok($meta->is_immutable, '... our class is now immutable');
d90b42a6	140	isa_ok($meta, 'Class::MOP::Class');
	141
	142	# they made a constructor for us :)
	143	can_ok('Bar', 'new');
	144
	145	{
	146	my $bar = Bar->new;
	147	isa_ok($bar, 'Bar');
	148	is($bar->bar, 'BAR', '... got the right default value');
	149	is($bar->baz, 'BAZ', '... got the right default value');
	150	}
	151
	152	{
	153	my $bar = Bar->new(bar => 'BAZ!', baz => 'BAR!');
	154	isa_ok($bar, 'Bar');
	155	is($bar->bar, 'BAZ!', '... got the right parameter value');
	156	is($bar->baz, 'BAR!', '... got the right parameter value');
	157	}
	158
	159	# check out accessors too
	160	{
	161	my $bar_accessor = $meta->find_method_by_name('bar');
	162	isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
	163	isa_ok($bar_accessor, 'Class::MOP::Method');
	164
	165	ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined');
	166
	167	my $baz_accessor = $meta->get_method('baz');
	168	isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
	169	isa_ok($baz_accessor, 'Class::MOP::Method');
	170
	171	ok($baz_accessor->is_inline, '... the baz accessor is not inlined');
	172	}
	173	}
	174
	175	{
	176	my $meta = Baz->meta;
	177	is($meta->name, 'Baz', '... checking the Bar metaclass');
	178
	179	{
	180	my $bar_accessor = $meta->find_method_by_name('bar');
	181	isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
	182	isa_ok($bar_accessor, 'Class::MOP::Method');
	183
	184	ok(!$bar_accessor->is_inline, '... the bar accessor is not inlined');
	185
	186	my $baz_accessor = $meta->find_method_by_name('baz');
	187	isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
	188	isa_ok($baz_accessor, 'Class::MOP::Method');
	189
	190	ok($baz_accessor->is_inline, '... the baz accessor is inlined');
	191
	192	my $bah_accessor = $meta->get_method('bah');
	193	isa_ok($bah_accessor, 'Class::MOP::Method::Accessor');
	194	isa_ok($bah_accessor, 'Class::MOP::Method');
	195
	196	ok(!$bah_accessor->is_inline, '... the baz accessor is not inlined');
	197	}
	198
	199	ok(!$meta->is_immutable, '... our class is not immutable');
	200
	201	lives_ok {
	202	$meta->make_immutable(
	203	inline_constructor => 0,
204	inline_accessors => 1,
205	);
206	} '... changed Bar to be immutable';
207
208	ok($meta->is_immutable, '... our class is now immutable');
d90b42a6	209	isa_ok($meta, 'Class::MOP::Class');
	210
	211	ok(!Baz->meta->has_method('new'), '... no constructor was made');
	212
	213	{
	214	my $baz = Baz->meta->construct_instance;
	215	isa_ok($baz, 'Bar');
	216	is($baz->bar, 'BAR', '... got the right default value');
	217	is($baz->baz, 'BAZ', '... got the right default value');
	218	}
	219
	220	{
	221	my $baz = Baz->meta->construct_instance(bar => 'BAZ!', baz => 'BAR!', bah => 'BAH!');
	222	isa_ok($baz, 'Baz');
	223	is($baz->bar, 'BAZ!', '... got the right parameter value');
	224	is($baz->baz, 'BAR!', '... got the right parameter value');
	225	is($baz->bah, 'BAH!', '... got the right parameter value');
	226	}
	227
	228	# check out accessors too
	229	{
	230	my $bar_accessor = $meta->find_method_by_name('bar');
	231	isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
	232	isa_ok($bar_accessor, 'Class::MOP::Method');
	233
	234	ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined');
	235
	236	my $baz_accessor = $meta->find_method_by_name('baz');
	237	isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
	238	isa_ok($baz_accessor, 'Class::MOP::Method');
	239
	240	ok($baz_accessor->is_inline, '... the baz accessor is not inlined');
	241
	242	my $bah_accessor = $meta->get_method('bah');
	243	isa_ok($bah_accessor, 'Class::MOP::Method::Accessor');
	244	isa_ok($bah_accessor, 'Class::MOP::Method');
	245
	246	ok($bah_accessor->is_inline, '... the baz accessor is not inlined');
	247	}
	248	}
	249