t/070_immutable_metaclass.t

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