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

#!/usr/bin/perl

use strict;
use warnings;

use Test::More tests => 93;
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',
    ));

    package Buzz;

    use strict;
    use warnings;
    use metaclass;


    __PACKAGE__->meta->add_attribute('bar' => (
        accessor  => 'bar',
        predicate => 'has_bar',
        clearer   => 'clear_bar',
    ));

    __PACKAGE__->meta->add_attribute('bah' => (
        accessor  => 'bah',
        predicate => 'has_bah',
        clearer   => 'clear_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');
    }
}


{
  my $buzz;
  ::lives_ok { $buzz = Buzz->meta->new_object } '...Buzz instantiated successfully';
  ::ok(!$buzz->has_bar, '...bar is not set');
  ::is($buzz->bar, undef, '...bar returns undef');
  ::ok(!$buzz->has_bar, '...bar was not autovivified');

  $buzz->bar(undef);
  ::ok($buzz->has_bar, '...bar is set');
  ::is($buzz->bar, undef, '...bar is undef');
  $buzz->clear_bar;
  ::ok(!$buzz->has_bar, '...bar is no longerset');

  my $buzz2;
  ::lives_ok { $buzz2 = Buzz->meta->new_object('bar' => undef) } '...Buzz instantiated successfully';
  ::ok($buzz2->has_bar, '...bar is set');
  ::is($buzz2->bar, undef, '...bar is undef');

}

{
  my $buzz;
  ::lives_ok { $buzz = Buzz->meta->new_object } '...Buzz instantiated successfully';
  ::ok($buzz->has_bah, '...bah is set');
  ::is($buzz->bah, 'BAH', '...bah returns "BAH"' );

  my $buzz2;
  ::lives_ok { $buzz2 = Buzz->meta->new_object('bah' => undef) } '...Buzz instantiated successfully';
  ::ok($buzz2->has_bah, '...bah is set');
  ::is($buzz2->bah, undef, '...bah is undef');

}
Commit	Line	Data
d90b42a6	1	#!/usr/bin/perl
	2
	3	use strict;
	4	use warnings;
	5
8768ecf3	6	use Test::More tests => 93;
d90b42a6	7	use Test::Exception;
	8
	9	BEGIN {
	10	use_ok('Class::MOP');
8768ecf3	11	use_ok('Class::MOP::Immutable');
d90b42a6	12	}
	13
	14	{
	15	package Foo;
8768ecf3	16
d90b42a6	17	use strict;
	18	use warnings;
	19	use metaclass;
8768ecf3	20
d90b42a6	21	__PACKAGE__->meta->add_attribute('bar' => (
	22	reader => 'bar',
	23	default => 'BAR',
	24	));
8768ecf3	25
d90b42a6	26	package Bar;
8768ecf3	27
d90b42a6	28	use strict;
	29	use warnings;
	30	use metaclass;
8768ecf3	31
d90b42a6	32	__PACKAGE__->meta->superclasses('Foo');
	33
	34	__PACKAGE__->meta->add_attribute('baz' => (
	35	reader => 'baz',
	36	default => sub { 'BAZ' },
8768ecf3	37	));
8768ecf3	38
d90b42a6	39	package Baz;
8768ecf3	40
d90b42a6	41	use strict;
	42	use warnings;
	43	use metaclass;
8768ecf3	44
d90b42a6	45	__PACKAGE__->meta->superclasses('Bar');
	46
	47	__PACKAGE__->meta->add_attribute('bah' => (
	48	reader => 'bah',
	49	default => 'BAH',
8768ecf3	50	));
	51
	52	package Buzz;
	53
	54	use strict;
	55	use warnings;
	56	use metaclass;
	57
	58
	59	__PACKAGE__->meta->add_attribute('bar' => (
	60	accessor => 'bar',
	61	predicate => 'has_bar',
	62	clearer => 'clear_bar',
	63	));
	64
	65	__PACKAGE__->meta->add_attribute('bah' => (
	66	accessor => 'bah',
	67	predicate => 'has_bah',
	68	clearer => 'clear_bah',
	69	default => 'BAH'
	70	));
	71
d90b42a6	72	}
	73
	74	{
	75	my $meta = Foo->meta;
	76	is($meta->name, 'Foo', '... checking the Foo metaclass');
8768ecf3	77
d90b42a6	78	{
	79	my $bar_accessor = $meta->get_method('bar');
	80	isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
8768ecf3	81	isa_ok($bar_accessor, 'Class::MOP::Method');
	82
	83	ok(!$bar_accessor->is_inline, '... the bar accessor is not inlined');
d90b42a6	84	}
8768ecf3	85
8768ecf3	86	ok(!$meta->is_immutable, '... our class is not immutable');
d90b42a6	87
	88	lives_ok {
	89	$meta->make_immutable(
	90	inline_constructor => 1,
8768ecf3	91	inline_accessors => 0,
d90b42a6	92	);
	93	} '... changed Foo to be immutable';
	94
8768ecf3	95	ok($meta->is_immutable, '... our class is now immutable');
	96	isa_ok($meta, 'Class::MOP::Class');
	97
d90b42a6	98	# they made a constructor for us :)
d90b42a6	99	can_ok('Foo', 'new');
8768ecf3	100
d90b42a6	101	{
	102	my $foo = Foo->new;
	103	isa_ok($foo, 'Foo');
	104	is($foo->bar, 'BAR', '... got the right default value');
	105	}
8768ecf3	106
d90b42a6	107	{
	108	my $foo = Foo->new(bar => 'BAZ');
	109	isa_ok($foo, 'Foo');
	110	is($foo->bar, 'BAZ', '... got the right parameter value');
8768ecf3	111	}
8768ecf3	112
565f0cbb	113	# NOTE:
	114	# check that the constructor correctly handles inheritance
	115	{
	116	my $bar = Bar->new();
	117	isa_ok($bar, 'Bar');
8768ecf3	118	isa_ok($bar, 'Foo');
565f0cbb	119	is($bar->bar, 'BAR', '... got the right inherited parameter value');
8768ecf3	120	is($bar->baz, 'BAZ', '... got the right inherited parameter value');
	121	}
	122
d90b42a6	123	# check out accessors too
	124	{
	125	my $bar_accessor = $meta->get_method('bar');
	126	isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
8768ecf3	127	isa_ok($bar_accessor, 'Class::MOP::Method');
	128
	129	ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined');
d90b42a6	130	}
	131	}
	132
	133	{
	134	my $meta = Bar->meta;
	135	is($meta->name, 'Bar', '... checking the Bar metaclass');
8768ecf3	136
d90b42a6	137	{
	138	my $bar_accessor = $meta->find_method_by_name('bar');
	139	isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
8768ecf3	140	isa_ok($bar_accessor, 'Class::MOP::Method');
	141
	142	ok(!$bar_accessor->is_inline, '... the bar accessor is not inlined');
	143
d90b42a6	144	my $baz_accessor = $meta->get_method('baz');
d90b42a6	145	isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
8768ecf3	146	isa_ok($baz_accessor, 'Class::MOP::Method');
	147
	148	ok(!$baz_accessor->is_inline, '... the baz accessor is not inlined');
d90b42a6	149	}
8768ecf3	150
8768ecf3	151	ok(!$meta->is_immutable, '... our class is not immutable');
d90b42a6	152
	153	lives_ok {
	154	$meta->make_immutable(
	155	inline_constructor => 1,
8768ecf3	156	inline_accessors => 1,
d90b42a6	157	);
	158	} '... changed Bar to be immutable';
	159
8768ecf3	160	ok($meta->is_immutable, '... our class is now immutable');
	161	isa_ok($meta, 'Class::MOP::Class');
	162
d90b42a6	163	# they made a constructor for us :)
d90b42a6	164	can_ok('Bar', 'new');
8768ecf3	165
d90b42a6	166	{
	167	my $bar = Bar->new;
	168	isa_ok($bar, 'Bar');
	169	is($bar->bar, 'BAR', '... got the right default value');
8768ecf3	170	is($bar->baz, 'BAZ', '... got the right default value');
d90b42a6	171	}
8768ecf3	172
d90b42a6	173	{
	174	my $bar = Bar->new(bar => 'BAZ!', baz => 'BAR!');
	175	isa_ok($bar, 'Bar');
	176	is($bar->bar, 'BAZ!', '... got the right parameter value');
8768ecf3	177	is($bar->baz, 'BAR!', '... got the right parameter value');
8768ecf3	178	}
d90b42a6	179
	180	# check out accessors too
	181	{
	182	my $bar_accessor = $meta->find_method_by_name('bar');
	183	isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
8768ecf3	184	isa_ok($bar_accessor, 'Class::MOP::Method');
	185
	186	ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined');
	187
d90b42a6	188	my $baz_accessor = $meta->get_method('baz');
d90b42a6	189	isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
8768ecf3	190	isa_ok($baz_accessor, 'Class::MOP::Method');
	191
	192	ok($baz_accessor->is_inline, '... the baz accessor is not inlined');
d90b42a6	193	}
	194	}
	195
	196	{
	197	my $meta = Baz->meta;
	198	is($meta->name, 'Baz', '... checking the Bar metaclass');
8768ecf3	199
d90b42a6	200	{
	201	my $bar_accessor = $meta->find_method_by_name('bar');
	202	isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
8768ecf3	203	isa_ok($bar_accessor, 'Class::MOP::Method');
	204
	205	ok(!$bar_accessor->is_inline, '... the bar accessor is not inlined');
	206
d90b42a6	207	my $baz_accessor = $meta->find_method_by_name('baz');
d90b42a6	208	isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
8768ecf3	209	isa_ok($baz_accessor, 'Class::MOP::Method');
	210
	211	ok($baz_accessor->is_inline, '... the baz accessor is inlined');
	212
d90b42a6	213	my $bah_accessor = $meta->get_method('bah');
d90b42a6	214	isa_ok($bah_accessor, 'Class::MOP::Method::Accessor');
8768ecf3	215	isa_ok($bah_accessor, 'Class::MOP::Method');
	216
	217	ok(!$bah_accessor->is_inline, '... the baz accessor is not inlined');
d90b42a6	218	}
8768ecf3	219
8768ecf3	220	ok(!$meta->is_immutable, '... our class is not immutable');
d90b42a6	221
	222	lives_ok {
	223	$meta->make_immutable(
	224	inline_constructor => 0,
8768ecf3	225	inline_accessors => 1,
d90b42a6	226	);
	227	} '... changed Bar to be immutable';
	228
8768ecf3	229	ok($meta->is_immutable, '... our class is now immutable');
	230	isa_ok($meta, 'Class::MOP::Class');
	231
d90b42a6	232	ok(!Baz->meta->has_method('new'), '... no constructor was made');
8768ecf3	233
d90b42a6	234	{
	235	my $baz = Baz->meta->construct_instance;
	236	isa_ok($baz, 'Bar');
	237	is($baz->bar, 'BAR', '... got the right default value');
8768ecf3	238	is($baz->baz, 'BAZ', '... got the right default value');
d90b42a6	239	}
8768ecf3	240
d90b42a6	241	{
	242	my $baz = Baz->meta->construct_instance(bar => 'BAZ!', baz => 'BAR!', bah => 'BAH!');
	243	isa_ok($baz, 'Baz');
	244	is($baz->bar, 'BAZ!', '... got the right parameter value');
	245	is($baz->baz, 'BAR!', '... got the right parameter value');
8768ecf3	246	is($baz->bah, 'BAH!', '... got the right parameter value');
8768ecf3	247	}
d90b42a6	248
	249	# check out accessors too
	250	{
	251	my $bar_accessor = $meta->find_method_by_name('bar');
	252	isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
8768ecf3	253	isa_ok($bar_accessor, 'Class::MOP::Method');
	254
	255	ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined');
	256
d90b42a6	257	my $baz_accessor = $meta->find_method_by_name('baz');
d90b42a6	258	isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
8768ecf3	259	isa_ok($baz_accessor, 'Class::MOP::Method');
	260
	261	ok($baz_accessor->is_inline, '... the baz accessor is not inlined');
d90b42a6	262
	263	my $bah_accessor = $meta->get_method('bah');
	264	isa_ok($bah_accessor, 'Class::MOP::Method::Accessor');
8768ecf3	265	isa_ok($bah_accessor, 'Class::MOP::Method');
	266
	267	ok($bah_accessor->is_inline, '... the baz accessor is not inlined');
d90b42a6	268	}
	269	}
	270
8768ecf3	271
	272	{
	273	my $buzz;
	274	::lives_ok { $buzz = Buzz->meta->new_object } '...Buzz instantiated successfully';
	275	::ok(!$buzz->has_bar, '...bar is not set');
	276	::is($buzz->bar, undef, '...bar returns undef');
	277	::ok(!$buzz->has_bar, '...bar was not autovivified');
	278
	279	$buzz->bar(undef);
	280	::ok($buzz->has_bar, '...bar is set');
	281	::is($buzz->bar, undef, '...bar is undef');
	282	$buzz->clear_bar;
	283	::ok(!$buzz->has_bar, '...bar is no longerset');
	284
	285	my $buzz2;
	286	::lives_ok { $buzz2 = Buzz->meta->new_object('bar' => undef) } '...Buzz instantiated successfully';
	287	::ok($buzz2->has_bar, '...bar is set');
	288	::is($buzz2->bar, undef, '...bar is undef');
	289
	290	}
	291
	292	{
	293	my $buzz;
	294	::lives_ok { $buzz = Buzz->meta->new_object } '...Buzz instantiated successfully';
	295	::ok($buzz->has_bah, '...bah is set');
	296	::is($buzz->bah, 'BAH', '...bah returns "BAH"' );
	297
	298	my $buzz2;
	299	::lives_ok { $buzz2 = Buzz->meta->new_object('bah' => undef) } '...Buzz instantiated successfully';
	300	::ok($buzz2->has_bah, '...bah is set');
	301	::is($buzz2->bah, undef, '...bah is undef');
	302
	303	}