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

use strict;
use warnings;

use Test::More;
use Test::Fatal;

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(!$bar_accessor->is_inline, '... the bar accessor is not inlined');
    }

    ok(!$meta->is_immutable, '... our class is not immutable');

    is( exception {
        $meta->make_immutable(
            inline_constructor => 1,
            inline_accessors   => 0,
        );
    }, undef, '... 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');

    is( exception {
        $meta->make_immutable(
            inline_constructor => 1,
            inline_accessors   => 1,
        );
    }, undef, '... 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');

    is( exception {
        $meta->make_immutable(
            inline_constructor => 0,
            inline_accessors   => 1,
        );
    }, undef, '... 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');

        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;
  ::is( ::exception { $buzz = Buzz->meta->new_object }, undef, '...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;
  ::is( ::exception { $buzz2 = Buzz->meta->new_object('bar' => undef) }, undef, '...Buzz instantiated successfully' );
  ::ok($buzz2->has_bar, '...bar is set');
  ::is($buzz2->bar, undef, '...bar is undef');

}

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

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

}

done_testing;
Commit	Line	Data
d90b42a6	1	use strict;
	2	use warnings;
	3
86a4d873	4	use Test::More;
871e9eb5	5	use Test::Fatal;
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');
	78
	79	ok(!$bar_accessor->is_inline, '... the bar accessor is not inlined');
d90b42a6	80	}
8768ecf3	81
8768ecf3	82	ok(!$meta->is_immutable, '... our class is not immutable');
d90b42a6	83
871e9eb5	84	is( exception {
d90b42a6	85	$meta->make_immutable(
d90b42a6	86	inline_constructor => 1,
8768ecf3	87	inline_accessors => 0,
d90b42a6	88	);
871e9eb5	89	}, undef, '... changed Foo to be immutable' );
d90b42a6	90
8768ecf3	91	ok($meta->is_immutable, '... our class is now immutable');
	92	isa_ok($meta, 'Class::MOP::Class');
	93
d90b42a6	94	# they made a constructor for us :)
d90b42a6	95	can_ok('Foo', 'new');
8768ecf3	96
d90b42a6	97	{
	98	my $foo = Foo->new;
	99	isa_ok($foo, 'Foo');
	100	is($foo->bar, 'BAR', '... got the right default value');
	101	}
8768ecf3	102
d90b42a6	103	{
	104	my $foo = Foo->new(bar => 'BAZ');
	105	isa_ok($foo, 'Foo');
	106	is($foo->bar, 'BAZ', '... got the right parameter value');
8768ecf3	107	}
8768ecf3	108
565f0cbb	109	# NOTE:
	110	# check that the constructor correctly handles inheritance
	111	{
	112	my $bar = Bar->new();
	113	isa_ok($bar, 'Bar');
8768ecf3	114	isa_ok($bar, 'Foo');
565f0cbb	115	is($bar->bar, 'BAR', '... got the right inherited parameter value');
8768ecf3	116	is($bar->baz, 'BAZ', '... got the right inherited parameter value');
	117	}
	118
d90b42a6	119	# check out accessors too
	120	{
	121	my $bar_accessor = $meta->get_method('bar');
	122	isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
8768ecf3	123	isa_ok($bar_accessor, 'Class::MOP::Method');
	124
	125	ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined');
d90b42a6	126	}
	127	}
	128
	129	{
	130	my $meta = Bar->meta;
	131	is($meta->name, 'Bar', '... checking the Bar metaclass');
8768ecf3	132
d90b42a6	133	{
	134	my $bar_accessor = $meta->find_method_by_name('bar');
	135	isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
8768ecf3	136	isa_ok($bar_accessor, 'Class::MOP::Method');
	137
	138	ok(!$bar_accessor->is_inline, '... the bar accessor is not inlined');
	139
d90b42a6	140	my $baz_accessor = $meta->get_method('baz');
d90b42a6	141	isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
8768ecf3	142	isa_ok($baz_accessor, 'Class::MOP::Method');
	143
	144	ok(!$baz_accessor->is_inline, '... the baz accessor is not inlined');
d90b42a6	145	}
8768ecf3	146
8768ecf3	147	ok(!$meta->is_immutable, '... our class is not immutable');
d90b42a6	148
871e9eb5	149	is( exception {
d90b42a6	150	$meta->make_immutable(
d90b42a6	151	inline_constructor => 1,
8768ecf3	152	inline_accessors => 1,
d90b42a6	153	);
871e9eb5	154	}, undef, '... changed Bar to be immutable' );
d90b42a6	155
8768ecf3	156	ok($meta->is_immutable, '... our class is now immutable');
	157	isa_ok($meta, 'Class::MOP::Class');
	158
d90b42a6	159	# they made a constructor for us :)
d90b42a6	160	can_ok('Bar', 'new');
8768ecf3	161
d90b42a6	162	{
	163	my $bar = Bar->new;
	164	isa_ok($bar, 'Bar');
	165	is($bar->bar, 'BAR', '... got the right default value');
8768ecf3	166	is($bar->baz, 'BAZ', '... got the right default value');
d90b42a6	167	}
8768ecf3	168
d90b42a6	169	{
	170	my $bar = Bar->new(bar => 'BAZ!', baz => 'BAR!');
	171	isa_ok($bar, 'Bar');
	172	is($bar->bar, 'BAZ!', '... got the right parameter value');
8768ecf3	173	is($bar->baz, 'BAR!', '... got the right parameter value');
8768ecf3	174	}
d90b42a6	175
	176	# check out accessors too
	177	{
	178	my $bar_accessor = $meta->find_method_by_name('bar');
	179	isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
8768ecf3	180	isa_ok($bar_accessor, 'Class::MOP::Method');
	181
	182	ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined');
	183
d90b42a6	184	my $baz_accessor = $meta->get_method('baz');
d90b42a6	185	isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
8768ecf3	186	isa_ok($baz_accessor, 'Class::MOP::Method');
	187
	188	ok($baz_accessor->is_inline, '... the baz accessor is not inlined');
d90b42a6	189	}
	190	}
	191
	192	{
	193	my $meta = Baz->meta;
	194	is($meta->name, 'Baz', '... checking the Bar metaclass');
8768ecf3	195
d90b42a6	196	{
	197	my $bar_accessor = $meta->find_method_by_name('bar');
	198	isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
8768ecf3	199	isa_ok($bar_accessor, 'Class::MOP::Method');
	200
	201	ok(!$bar_accessor->is_inline, '... the bar accessor is not inlined');
	202
d90b42a6	203	my $baz_accessor = $meta->find_method_by_name('baz');
d90b42a6	204	isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
8768ecf3	205	isa_ok($baz_accessor, 'Class::MOP::Method');
	206
	207	ok($baz_accessor->is_inline, '... the baz accessor is inlined');
	208
d90b42a6	209	my $bah_accessor = $meta->get_method('bah');
d90b42a6	210	isa_ok($bah_accessor, 'Class::MOP::Method::Accessor');
8768ecf3	211	isa_ok($bah_accessor, 'Class::MOP::Method');
	212
	213	ok(!$bah_accessor->is_inline, '... the baz accessor is not inlined');
d90b42a6	214	}
8768ecf3	215
8768ecf3	216	ok(!$meta->is_immutable, '... our class is not immutable');
d90b42a6	217
871e9eb5	218	is( exception {
d90b42a6	219	$meta->make_immutable(
d90b42a6	220	inline_constructor => 0,
8768ecf3	221	inline_accessors => 1,
d90b42a6	222	);
871e9eb5	223	}, undef, '... changed Bar to be immutable' );
d90b42a6	224
8768ecf3	225	ok($meta->is_immutable, '... our class is now immutable');
	226	isa_ok($meta, 'Class::MOP::Class');
	227
d90b42a6	228	ok(!Baz->meta->has_method('new'), '... no constructor was made');
8768ecf3	229
d90b42a6	230	{
d69fb6b3	231	my $baz = Baz->meta->new_object;
d90b42a6	232	isa_ok($baz, 'Bar');
d90b42a6	233	is($baz->bar, 'BAR', '... got the right default value');
8768ecf3	234	is($baz->baz, 'BAZ', '... got the right default value');
d90b42a6	235	}
8768ecf3	236
d90b42a6	237	{
d69fb6b3	238	my $baz = Baz->meta->new_object(bar => 'BAZ!', baz => 'BAR!', bah => 'BAH!');
d90b42a6	239	isa_ok($baz, 'Baz');
	240	is($baz->bar, 'BAZ!', '... got the right parameter value');
	241	is($baz->baz, 'BAR!', '... got the right parameter value');
8768ecf3	242	is($baz->bah, 'BAH!', '... got the right parameter value');
8768ecf3	243	}
d90b42a6	244
	245	# check out accessors too
	246	{
	247	my $bar_accessor = $meta->find_method_by_name('bar');
	248	isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
8768ecf3	249	isa_ok($bar_accessor, 'Class::MOP::Method');
	250
	251	ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined');
	252
d90b42a6	253	my $baz_accessor = $meta->find_method_by_name('baz');
d90b42a6	254	isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
8768ecf3	255	isa_ok($baz_accessor, 'Class::MOP::Method');
	256
	257	ok($baz_accessor->is_inline, '... the baz accessor is not inlined');
d90b42a6	258
	259	my $bah_accessor = $meta->get_method('bah');
	260	isa_ok($bah_accessor, 'Class::MOP::Method::Accessor');
8768ecf3	261	isa_ok($bah_accessor, 'Class::MOP::Method');
	262
	263	ok($bah_accessor->is_inline, '... the baz accessor is not inlined');
d90b42a6	264	}
	265	}
	266
8768ecf3	267
	268	{
	269	my $buzz;
871e9eb5	270	::is( ::exception { $buzz = Buzz->meta->new_object }, undef, '...Buzz instantiated successfully' );
8768ecf3	271	::ok(!$buzz->has_bar, '...bar is not set');
	272	::is($buzz->bar, undef, '...bar returns undef');
	273	::ok(!$buzz->has_bar, '...bar was not autovivified');
	274
	275	$buzz->bar(undef);
	276	::ok($buzz->has_bar, '...bar is set');
	277	::is($buzz->bar, undef, '...bar is undef');
	278	$buzz->clear_bar;
	279	::ok(!$buzz->has_bar, '...bar is no longerset');
	280
	281	my $buzz2;
871e9eb5	282	::is( ::exception { $buzz2 = Buzz->meta->new_object('bar' => undef) }, undef, '...Buzz instantiated successfully' );
8768ecf3	283	::ok($buzz2->has_bar, '...bar is set');
	284	::is($buzz2->bar, undef, '...bar is undef');
	285
	286	}
	287
	288	{
	289	my $buzz;
871e9eb5	290	::is( ::exception { $buzz = Buzz->meta->new_object }, undef, '...Buzz instantiated successfully' );
8768ecf3	291	::ok($buzz->has_bah, '...bah is set');
	292	::is($buzz->bah, 'BAH', '...bah returns "BAH"' );
	293
	294	my $buzz2;
871e9eb5	295	::is( ::exception { $buzz2 = Buzz->meta->new_object('bah' => undef) }, undef, '...Buzz instantiated successfully' );
8768ecf3	296	::ok($buzz2->has_bah, '...bah is set');
	297	::is($buzz2->bah, undef, '...bah is undef');
	298
	299	}
86a4d873	300
86a4d873	301	done_testing;