t/070_immutable_metaclass.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::More tests => 86;
   5 use Test::Exception;
   6
   7 use Class::MOP;
   8
   9 {
  10     package Foo;
  11
  12     use strict;
  13     use warnings;
  14     use metaclass;
  15
  16     __PACKAGE__->meta->add_attribute('bar');
  17
  18     package Bar;
  19
  20     use strict;
  21     use warnings;
  22     use metaclass;
  23
  24     __PACKAGE__->meta->superclasses('Foo');
  25
  26     __PACKAGE__->meta->add_attribute('baz');
  27
  28     package Baz;
  29
  30     use strict;
  31     use warnings;
  32     use metaclass;
  33
  34     __PACKAGE__->meta->superclasses('Bar');
  35
  36     __PACKAGE__->meta->add_attribute('bah');
  37 }
  38
  39 {
  40   my $meta = Foo->meta;
  41
  42   my $transformer;
  43   lives_ok{ $transformer = $meta->create_immutable_transformer }
  44     "Created immutable transformer";
  45   isa_ok($transformer, 'Class::MOP::Immutable', '... transformer isa Class::MOP::Immutable');
  46   my $methods = $transformer->create_methods_for_immutable_metaclass;
  47
  48   my $immutable_metaclass = $transformer->immutable_metaclass;
  49   is($transformer->metaclass, $meta,      '... transformer has correct metaclass');
  50   ok(!$transformer->inlined_constructor,  '... transformer says it did not inline the constructor');
  51   ok($immutable_metaclass->is_anon_class, '... immutable_metaclass is an anonymous class');
  52
  53   #I don't understand why i need to ->meta here...
  54   my $obj = $immutable_metaclass->name;
  55   ok(!$obj->is_mutable,     '... immutable_metaclass is not mutable');
  56   ok($obj->is_immutable,    '... immutable_metaclass is immutable');
  57   ok(!$obj->make_immutable, '... immutable_metaclass make_mutable is noop');
  58   is($obj->meta, $immutable_metaclass, '... immutable_metaclass meta hack works');
  59
  60   is_deeply(
  61             [ $immutable_metaclass->superclasses ],
  62             [ Scalar::Util::blessed($meta) ],
  63             '... immutable_metaclass superclasses are correct'
  64            );
  65   ok($immutable_metaclass->has_method('get_mutable_metaclass_name'),
  66      'immutable metaclass has get_mutable_metaclass_name method');
  67
  68 }
  69
  70 {
  71     my $meta = Foo->meta;
  72     is($meta->name, 'Foo', '... checking the Foo metaclass');
  73
  74     ok($meta->is_mutable, '... our class is mutable');
  75     ok(!$meta->is_immutable, '... our class is not immutable');
  76
  77     my $transformer = $meta->get_immutable_transformer;
  78
  79     lives_ok {
  80         $meta->make_immutable();
  81     } '... changed Foo to be immutable';
  82
  83     ok($transformer->inlined_constructor,  '... transformer says it did inline the constructor');
  84     is($transformer, $meta->get_immutable_transformer, '... immutable transformer cache works');
  85     ok(!$meta->make_immutable, '... make immutable now returns nothing');
  86
  87     ok(!$meta->is_mutable, '... our class is no longer mutable');
  88     ok($meta->is_immutable, '... our class is now immutable');
  89
  90     isa_ok($meta, 'Class::MOP::Class');
  91
  92     dies_ok { $meta->add_method()    } '... exception thrown as expected';
  93     dies_ok { $meta->alias_method()  } '... exception thrown as expected';
  94     dies_ok { $meta->remove_method() } '... exception thrown as expected';
  95
  96     dies_ok { $meta->add_attribute()    } '... exception thrown as expected';
  97     dies_ok { $meta->remove_attribute() } '... exception thrown as expected';
  98
  99     dies_ok { $meta->add_package_symbol()    } '... exception thrown as expected';
 100     dies_ok { $meta->remove_package_symbol() } '... exception thrown as expected';
 101
 102     lives_ok { $meta->identifier() } '... no exception for get_package_symbol special case';
 103
 104     my @supers;
 105     lives_ok {
 106         @supers = $meta->superclasses;
 107     } '... got the superclasses okay';
 108
 109     dies_ok { $meta->superclasses([ 'UNIVERSAL' ]) } '... but could not set the superclasses okay';
 110
 111     my $meta_instance;
 112     lives_ok {
 113         $meta_instance = $meta->get_meta_instance;
 114     } '... got the meta instance okay';
 115     isa_ok($meta_instance, 'Class::MOP::Instance');
 116     is($meta_instance, $meta->get_meta_instance, '... and we know it is cached');
 117
 118     my @cpl;
 119     lives_ok {
 120         @cpl = $meta->class_precedence_list;
 121     } '... got the class precedence list okay';
 122     is_deeply(
 123     \@cpl,
 124     [ 'Foo' ],
 125     '... we just have ourselves in the class precedence list');
 126
 127     my @attributes;
 128     lives_ok {
 129         @attributes = $meta->compute_all_applicable_attributes;
 130     } '... got the attribute list okay';
 131     is_deeply(
 132     \@attributes,
 133     [ $meta->get_attribute('bar') ],
 134     '... got the right list of attributes');
 135 }
 136
 137 {
 138     my $meta = Bar->meta;
 139     is($meta->name, 'Bar', '... checking the Bar metaclass');
 140
 141     ok($meta->is_mutable, '... our class is mutable');
 142     ok(!$meta->is_immutable, '... our class is not immutable');
 143
 144     lives_ok {
 145         $meta->make_immutable();
 146     } '... changed Bar to be immutable';
 147
 148     ok(!$meta->make_immutable, '... make immutable now returns nothing');
 149
 150     ok(!$meta->is_mutable, '... our class is no longer mutable');
 151     ok($meta->is_immutable, '... our class is now immutable');
 152
 153     isa_ok($meta, 'Class::MOP::Class');
 154
 155     dies_ok { $meta->add_method()    } '... exception thrown as expected';
 156     dies_ok { $meta->alias_method()  } '... exception thrown as expected';
 157     dies_ok { $meta->remove_method() } '... exception thrown as expected';
 158
 159     dies_ok { $meta->add_attribute()    } '... exception thrown as expected';
 160     dies_ok { $meta->remove_attribute() } '... exception thrown as expected';
 161
 162     dies_ok { $meta->add_package_symbol()    } '... exception thrown as expected';
 163     dies_ok { $meta->remove_package_symbol() } '... exception thrown as expected';
 164
 165     my @supers;
 166     lives_ok {
 167         @supers = $meta->superclasses;
 168     } '... got the superclasses okay';
 169
 170     dies_ok { $meta->superclasses([ 'UNIVERSAL' ]) } '... but could not set the superclasses okay';
 171
 172     my $meta_instance;
 173     lives_ok {
 174         $meta_instance = $meta->get_meta_instance;
 175     } '... got the meta instance okay';
 176     isa_ok($meta_instance, 'Class::MOP::Instance');
 177     is($meta_instance, $meta->get_meta_instance, '... and we know it is cached');
 178
 179     my @cpl;
 180     lives_ok {
 181         @cpl = $meta->class_precedence_list;
 182     } '... got the class precedence list okay';
 183     is_deeply(
 184     \@cpl,
 185     [ 'Bar', 'Foo'],
 186     '... we just have ourselves in the class precedence list');
 187
 188     my @attributes;
 189     lives_ok {
 190         @attributes = $meta->compute_all_applicable_attributes;
 191     } '... got the attribute list okay';
 192     is_deeply(
 193     [ sort { $a->name cmp $b->name } @attributes ],
 194     [ Foo->meta->get_attribute('bar'), $meta->get_attribute('baz') ],
 195     '... got the right list of attributes');
 196 }
 197
 198 {
 199     my $meta = Baz->meta;
 200     is($meta->name, 'Baz', '... checking the Baz metaclass');
 201
 202     ok($meta->is_mutable, '... our class is mutable');
 203     ok(!$meta->is_immutable, '... our class is not immutable');
 204
 205     lives_ok {
 206         $meta->make_immutable();
 207     } '... changed Baz to be immutable';
 208
 209     ok(!$meta->make_immutable, '... make immutable now returns nothing');
 210
 211     ok(!$meta->is_mutable, '... our class is no longer mutable');
 212     ok($meta->is_immutable, '... our class is now immutable');
 213
 214     isa_ok($meta, 'Class::MOP::Class');
 215
 216     dies_ok { $meta->add_method()    } '... exception thrown as expected';
 217     dies_ok { $meta->alias_method()  } '... exception thrown as expected';
 218     dies_ok { $meta->remove_method() } '... exception thrown as expected';
 219
 220     dies_ok { $meta->add_attribute()    } '... exception thrown as expected';
 221     dies_ok { $meta->remove_attribute() } '... exception thrown as expected';
 222
 223     dies_ok { $meta->add_package_symbol()    } '... exception thrown as expected';
 224     dies_ok { $meta->remove_package_symbol() } '... exception thrown as expected';
 225
 226     my @supers;
 227     lives_ok {
 228         @supers = $meta->superclasses;
 229     } '... got the superclasses okay';
 230
 231     dies_ok { $meta->superclasses([ 'UNIVERSAL' ]) } '... but could not set the superclasses okay';
 232
 233     my $meta_instance;
 234     lives_ok {
 235         $meta_instance = $meta->get_meta_instance;
 236     } '... got the meta instance okay';
 237     isa_ok($meta_instance, 'Class::MOP::Instance');
 238     is($meta_instance, $meta->get_meta_instance, '... and we know it is cached');
 239
 240     my @cpl;
 241     lives_ok {
 242         @cpl = $meta->class_precedence_list;
 243     } '... got the class precedence list okay';
 244     is_deeply(
 245     \@cpl,
 246     [ 'Baz', 'Bar', 'Foo'],
 247     '... we just have ourselves in the class precedence list');
 248
 249     my @attributes;
 250     lives_ok {
 251         @attributes = $meta->compute_all_applicable_attributes;
 252     } '... got the attribute list okay';
 253     is_deeply(
 254     [ sort { $a->name cmp $b->name } @attributes ],
 255     [ $meta->get_attribute('bah'), Foo->meta->get_attribute('bar'), Bar->meta->get_attribute('baz') ],
 256     '... got the right list of attributes');
 257 }
 258
 259