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

#!/usr/bin/perl

use strict;
use warnings;

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

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