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

use strict;
use warnings;

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

use Class::MOP;


{
    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(!$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');
    }
}

{
    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');

        my $baz_accessor = $meta->get_method('baz');
        isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
        isa_ok($baz_accessor, 'Class::MOP::Method');
    }

    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');

        my $baz_accessor = $meta->get_method('baz');
        isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
        isa_ok($baz_accessor, 'Class::MOP::Method');

    }
}

{
    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');

        my $baz_accessor = $meta->find_method_by_name('baz');
        isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
        isa_ok($baz_accessor, 'Class::MOP::Method');

        my $bah_accessor = $meta->get_method('bah');
        isa_ok($bah_accessor, 'Class::MOP::Method::Accessor');
        isa_ok($bah_accessor, 'Class::MOP::Method');
    }

    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->new_object;
        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->new_object(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');

        my $baz_accessor = $meta->find_method_by_name('baz');
        isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
        isa_ok($baz_accessor, 'Class::MOP::Method');

        my $bah_accessor = $meta->get_method('bah');
        isa_ok($bah_accessor, 'Class::MOP::Method::Accessor');
        isa_ok($bah_accessor, 'Class::MOP::Method');

    }
}


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