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

#!/usr/bin/perl

use strict;
use warnings;

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

BEGIN {
    use_ok('Class::MOP');
    use_ok('Class::MOP::Class::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',
    ));    
}

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

    # 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::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::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');        
    }
}
Commit	Line	Data
817c7cd5	1	#!/usr/bin/perl
	2
	3	use strict;
	4	use warnings;
	5
	6	use Test::More tests => 76;
	7	use Test::Exception;
	8
	9	BEGIN {
	10	use_ok('Class::MOP');
	11	use_ok('Class::MOP::Class::Immutable');
	12	}
	13
	14	{
	15	package Foo;
	16
	17	use strict;
	18	use warnings;
	19	use metaclass;
	20
	21	__PACKAGE__->meta->add_attribute('bar' => (
	22	reader => 'bar',
	23	default => 'BAR',
	24	));
	25
	26	package Bar;
	27
	28	use strict;
	29	use warnings;
	30	use metaclass;
	31
	32	__PACKAGE__->meta->superclasses('Foo');
	33
	34	__PACKAGE__->meta->add_attribute('baz' => (
	35	reader => 'baz',
	36	default => sub { 'BAZ' },
	37	));
	38
	39	package Baz;
	40
	41	use strict;
	42	use warnings;
	43	use metaclass;
	44
	45	__PACKAGE__->meta->superclasses('Bar');
	46
	47	__PACKAGE__->meta->add_attribute('bah' => (
	48	reader => 'bah',
	49	default => 'BAH',
	50	));
	51	}
	52
	53	{
	54	my $meta = Foo->meta;
	55	is($meta->name, 'Foo', '... checking the Foo metaclass');
	56
	57	{
	58	my $bar_accessor = $meta->get_method('bar');
	59	isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
	60	isa_ok($bar_accessor, 'Class::MOP::Method');
	61
	62	ok(!$bar_accessor->is_inline, '... the bar accessor is not inlined');
	63	}
	64
65	ok(!$meta->is_immutable, '... our class is not immutable');
66
67	lives_ok {
68	$meta->make_immutable(
69	inline_constructor => 1,
70	inline_accessors => 0,
71	);
72	} '... changed Foo to be immutable';
73
74	ok($meta->is_immutable, '... our class is now immutable');
75	isa_ok($meta, 'Class::MOP::Class::Immutable');
76	isa_ok($meta, 'Class::MOP::Class');
77
78	# they made a constructor for us :)
79	can_ok('Foo', 'new');
80
81	{
82	my $foo = Foo->new;
83	isa_ok($foo, 'Foo');
84	is($foo->bar, 'BAR', '... got the right default value');
85	}
86
87	{
88	my $foo = Foo->new(bar => 'BAZ');
89	isa_ok($foo, 'Foo');
90	is($foo->bar, 'BAZ', '... got the right parameter value');
91	}
92
93	# check out accessors too
94	{
95	my $bar_accessor = $meta->get_method('bar');
96	isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
97	isa_ok($bar_accessor, 'Class::MOP::Method');
98
99	ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined');
100	}
101	}
102
103	{
104	my $meta = Bar->meta;
105	is($meta->name, 'Bar', '... checking the Bar metaclass');
106
107	{
108	my $bar_accessor = $meta->find_method_by_name('bar');
109	isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
110	isa_ok($bar_accessor, 'Class::MOP::Method');
111
112	ok(!$bar_accessor->is_inline, '... the bar accessor is not inlined');
113
114	my $baz_accessor = $meta->get_method('baz');
115	isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
116	isa_ok($baz_accessor, 'Class::MOP::Method');
117
118	ok(!$baz_accessor->is_inline, '... the baz accessor is not inlined');
119	}
120
121	ok(!$meta->is_immutable, '... our class is not immutable');
122
123	lives_ok {
124	$meta->make_immutable(
125	inline_constructor => 1,
126	inline_accessors => 1,
127	);
128	} '... changed Bar to be immutable';
129
130	ok($meta->is_immutable, '... our class is now immutable');
131	isa_ok($meta, 'Class::MOP::Class::Immutable');
132	isa_ok($meta, 'Class::MOP::Class');
133
134	# they made a constructor for us :)
135	can_ok('Bar', 'new');
136
137	{
138	my $bar = Bar->new;
139	isa_ok($bar, 'Bar');
140	is($bar->bar, 'BAR', '... got the right default value');
141	is($bar->baz, 'BAZ', '... got the right default value');
142	}
143
144	{
145	my $bar = Bar->new(bar => 'BAZ!', baz => 'BAR!');
146	isa_ok($bar, 'Bar');
147	is($bar->bar, 'BAZ!', '... got the right parameter value');
148	is($bar->baz, 'BAR!', '... got the right parameter value');
149	}
150
151	# check out accessors too
152	{
153	my $bar_accessor = $meta->find_method_by_name('bar');
154	isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
155	isa_ok($bar_accessor, 'Class::MOP::Method');
156
157	ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined');
158
159	my $baz_accessor = $meta->get_method('baz');
160	isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
161	isa_ok($baz_accessor, 'Class::MOP::Method');
162
163	ok($baz_accessor->is_inline, '... the baz accessor is not inlined');
164	}
165	}
166
167	{
168	my $meta = Baz->meta;
169	is($meta->name, 'Baz', '... checking the Bar metaclass');
170
171	{
172	my $bar_accessor = $meta->find_method_by_name('bar');
173	isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
174	isa_ok($bar_accessor, 'Class::MOP::Method');
175
176	ok(!$bar_accessor->is_inline, '... the bar accessor is not inlined');
177
178	my $baz_accessor = $meta->find_method_by_name('baz');
179	isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
180	isa_ok($baz_accessor, 'Class::MOP::Method');
181
182	ok($baz_accessor->is_inline, '... the baz accessor is inlined');
183
184	my $bah_accessor = $meta->get_method('bah');
185	isa_ok($bah_accessor, 'Class::MOP::Method::Accessor');
186	isa_ok($bah_accessor, 'Class::MOP::Method');
187
188	ok(!$bah_accessor->is_inline, '... the baz accessor is not inlined');
189	}
190
191	ok(!$meta->is_immutable, '... our class is not immutable');
192
193	lives_ok {
194	$meta->make_immutable(
195	inline_constructor => 0,
196	inline_accessors => 1,
197	);
198	} '... changed Bar to be immutable';
199
200	ok($meta->is_immutable, '... our class is now immutable');
201	isa_ok($meta, 'Class::MOP::Class::Immutable');
202	isa_ok($meta, 'Class::MOP::Class');
203
204	ok(!Baz->meta->has_method('new'), '... no constructor was made');
205
206	{
207	my $baz = Baz->meta->construct_instance;
208	isa_ok($baz, 'Bar');
209	is($baz->bar, 'BAR', '... got the right default value');
210	is($baz->baz, 'BAZ', '... got the right default value');
211	}
212
213	{
214	my $baz = Baz->meta->construct_instance(bar => 'BAZ!', baz => 'BAR!', bah => 'BAH!');
215	isa_ok($baz, 'Baz');
216	is($baz->bar, 'BAZ!', '... got the right parameter value');
217	is($baz->baz, 'BAR!', '... got the right parameter value');
218	is($baz->bah, 'BAH!', '... got the right parameter value');
219	}
220
221	# check out accessors too
222	{
223	my $bar_accessor = $meta->find_method_by_name('bar');
224	isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
225	isa_ok($bar_accessor, 'Class::MOP::Method');
226
227	ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined');
228
229	my $baz_accessor = $meta->find_method_by_name('baz');
230	isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
231	isa_ok($baz_accessor, 'Class::MOP::Method');
232
233	ok($baz_accessor->is_inline, '... the baz accessor is not inlined');
234
235	my $bah_accessor = $meta->get_method('bah');
236	isa_ok($bah_accessor, 'Class::MOP::Method::Accessor');
237	isa_ok($bah_accessor, 'Class::MOP::Method');
238
239	ok($bah_accessor->is_inline, '... the baz accessor is not inlined');
240	}
241	}
242