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