18 __PACKAGE__->meta->add_attribute('bar');
26 __PACKAGE__->meta->superclasses('Foo');
28 __PACKAGE__->meta->add_attribute('baz');
36 __PACKAGE__->meta->superclasses('Bar');
38 __PACKAGE__->meta->add_attribute('bah');
43 is($meta->name, 'Baz', '... checking the Baz metaclass');
44 my %orig_keys = map { $_ => 1 } grep { !/^_/ } keys %$meta;
45 # Since this has no default it won't be present yet, but it will
46 # be after the class is made immutable.
48 is( exception {$meta->make_immutable; }, undef, '... changed Baz to be immutable' );
49 ok(!$meta->is_mutable, '... our class is no longer mutable');
50 ok($meta->is_immutable, '... our class is now immutable');
51 ok(!$meta->make_immutable, '... make immutable now returns nothing');
52 ok($meta->get_method('new'), '... inlined constructor created');
53 ok($meta->has_method('new'), '... inlined constructor created for sure');
54 is_deeply([ map { $_->name } $meta->_inlined_methods ], [ 'new' ], '... really, i mean it');
56 is( exception { $meta->make_mutable; }, undef, '... changed Baz to be mutable' );
57 ok($meta->is_mutable, '... our class is mutable');
58 ok(!$meta->is_immutable, '... our class is not immutable');
59 ok(!$meta->make_mutable, '... make mutable now returns nothing');
60 ok(!$meta->get_method('new'), '... inlined constructor created');
61 ok(!$meta->has_method('new'), '... inlined constructor removed for sure');
63 my %new_keys = map { $_ => 1 } grep { !/^_/ } keys %$meta;
64 is_deeply(\%orig_keys, \%new_keys, '... no extraneous hashkeys');
66 isa_ok($meta, 'Class::MOP::Class', '... Baz->meta isa Class::MOP::Class');
68 $meta->add_method('xyz', sub{'xxx'});
69 is( Baz->xyz, 'xxx', '... method xyz works');
71 ok($meta->add_attribute('fickle', accessor => 'fickle'), '... added attribute');
72 ok(Baz->can('fickle'), '... Baz can fickle');
73 ok($meta->remove_attribute('fickle'), '... removed attribute');
76 $meta->add_package_symbol('$ref', $reef);
77 is($meta->get_package_symbol('$ref'), $reef, '... values match');
78 is( exception { $meta->remove_package_symbol('$ref') }, undef, '... removed it' );
79 isnt($meta->get_package_symbol('$ref'), $reef, '... values match');
81 ok( my @supers = $meta->superclasses, '... got the superclasses okay');
82 ok( $meta->superclasses('Foo'), '... set the superclasses');
83 is_deeply(['Foo'], [$meta->superclasses], '... set the superclasses okay');
84 ok( $meta->superclasses( @supers ), '... reset superclasses');
85 is_deeply([@supers], [$meta->superclasses], '... reset the superclasses okay');
87 ok( $meta->$_ , "... ${_} works")
88 for qw(get_meta_instance get_all_attributes
89 class_precedence_list );
91 is( exception {$meta->make_immutable; }, undef, '... changed Baz to be immutable again' );
92 ok($meta->get_method('new'), '... inlined constructor recreated');
98 is( exception { $meta->make_immutable() }, undef, 'Changed Baz to be immutable' );
99 is( exception { $meta->make_mutable() }, undef, '... changed Baz to be mutable' );
100 is( exception { $meta->make_immutable() }, undef, '... changed Baz to be immutable' );
102 isnt( exception { $meta->add_method('xyz', sub{'xxx'}) }, undef, '... exception thrown as expected' );
105 $meta->add_attribute('fickle', accessor => 'fickle')
106 }, undef, '... exception thrown as expected' );
107 isnt( exception { $meta->remove_attribute('fickle') }, undef, '... exception thrown as expected' );
110 isnt( exception { $meta->add_package_symbol('$ref', $reef) }, undef, '... exception thrown as expected' );
111 isnt( exception { $meta->remove_package_symbol('$ref') }, undef, '... exception thrown as expected' );
113 ok( my @supers = $meta->superclasses, '... got the superclasses okay');
114 isnt( exception { $meta->superclasses('Foo') }, undef, '... set the superclasses' );
116 ok( $meta->$_ , "... ${_} works")
117 for qw(get_meta_instance get_all_attributes
118 class_precedence_list );
123 ok(Baz->meta->is_immutable, 'Superclass is immutable');
124 my $meta = Baz->meta->create_anon_class(superclasses => ['Baz']);
125 my %orig_keys = map { $_ => 1 } grep { !/^_/ } keys %$meta;
126 my @orig_meths = sort { $a->name cmp $b->name } $meta->get_all_methods;
127 ok($meta->is_anon_class, 'We have an anon metaclass');
128 ok($meta->is_mutable, '... our anon class is mutable');
129 ok(!$meta->is_immutable, '... our anon class is not immutable');
131 is( exception {$meta->make_immutable(
132 inline_accessor => 1,
133 inline_destructor => 0,
134 inline_constructor => 1,
136 }, undef, '... changed class to be immutable' );
137 ok(!$meta->is_mutable, '... our class is no longer mutable');
138 ok($meta->is_immutable, '... our class is now immutable');
139 ok(!$meta->make_immutable, '... make immutable now returns nothing');
141 is( exception { $meta->make_mutable }, undef, '... changed Baz to be mutable' );
142 ok($meta->is_mutable, '... our class is mutable');
143 ok(!$meta->is_immutable, '... our class is not immutable');
144 ok(!$meta->make_mutable, '... make mutable now returns nothing');
145 ok($meta->is_anon_class, '... still marked as an anon class');
146 my $instance = $meta->new_object;
148 my %new_keys = map { $_ => 1 } grep { !/^_/ } keys %$meta;
149 my @new_meths = sort { $a->name cmp $b->name }
150 $meta->get_all_methods;
151 is_deeply(\%orig_keys, \%new_keys, '... no extraneous hashkeys');
152 is_deeply(\@orig_meths, \@new_meths, '... no straneous methods');
154 isa_ok($meta, 'Class::MOP::Class', '... Anon class isa Class::MOP::Class');
156 $meta->add_method('xyz', sub{'xxx'});
157 is( $instance->xyz , 'xxx', '... method xyz works');
158 ok( $meta->remove_method('xyz'), '... removed method');
160 ok($meta->add_attribute('fickle', accessor => 'fickle'), '... added attribute');
161 ok($instance->can('fickle'), '... instance can fickle');
162 ok($meta->remove_attribute('fickle'), '... removed attribute');
165 $meta->add_package_symbol('$ref', $reef);
166 is($meta->get_package_symbol('$ref'), $reef, '... values match');
167 is( exception { $meta->remove_package_symbol('$ref') }, undef, '... removed it' );
168 isnt($meta->get_package_symbol('$ref'), $reef, '... values match');
170 ok( my @supers = $meta->superclasses, '... got the superclasses okay');
171 ok( $meta->superclasses('Foo'), '... set the superclasses');
172 is_deeply(['Foo'], [$meta->superclasses], '... set the superclasses okay');
173 ok( $meta->superclasses( @supers ), '... reset superclasses');
174 is_deeply([@supers], [$meta->superclasses], '... reset the superclasses okay');
176 ok( $meta->$_ , "... ${_} works")
177 for qw(get_meta_instance get_all_attributes
178 class_precedence_list );
182 #rerun the same tests on an anon class.. just cause we can.
184 my $meta = Baz->meta->create_anon_class(superclasses => ['Baz']);
186 is( exception {$meta->make_immutable(
187 inline_accessor => 1,
188 inline_destructor => 0,
189 inline_constructor => 1,
191 }, undef, '... changed class to be immutable' );
192 is( exception { $meta->make_mutable() }, undef, '... changed class to be mutable' );
193 is( exception {$meta->make_immutable }, undef, '... changed class to be immutable' );
195 isnt( exception { $meta->add_method('xyz', sub{'xxx'}) }, undef, '... exception thrown as expected' );
198 $meta->add_attribute('fickle', accessor => 'fickle')
199 }, undef, '... exception thrown as expected' );
200 isnt( exception { $meta->remove_attribute('fickle') }, undef, '... exception thrown as expected' );
203 isnt( exception { $meta->add_package_symbol('$ref', $reef) }, undef, '... exception thrown as expected' );
204 isnt( exception { $meta->remove_package_symbol('$ref') }, undef, '... exception thrown as expected' );
206 ok( my @supers = $meta->superclasses, '... got the superclasses okay');
207 isnt( exception { $meta->superclasses('Foo') }, undef, '... set the superclasses' );
209 ok( $meta->$_ , "... ${_} works")
210 for qw(get_meta_instance get_all_attributes
211 class_precedence_list );
215 Foo->meta->make_immutable;
216 Bar->meta->make_immutable;
217 Bar->meta->make_mutable;