t/070_immutable_metaclass.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 84;
   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($immutable_metaclass->is_anon_class, '... immutable_metaclass is an anonymous class');
  53
  54   #I don't understand why i need to ->meta here...
  55   my $obj = $immutable_metaclass->name;
  56   ok(!$obj->is_mutable,     '... immutable_metaclass is not mutable');
  57   ok($obj->is_immutable,    '... immutable_metaclass is immutable');
  58   ok(!$obj->make_immutable, '... immutable_metaclass make_mutable is noop');
  59   is($obj->meta, $immutable_metaclass, '... immutable_metaclass meta hack works');
  60
  61   is_deeply(
  62             [ $immutable_metaclass->superclasses ],
  63             [ Scalar::Util::blessed($meta) ],
  64             '... immutable_metaclass superclasses are correct'
  65            );
  66   ok($immutable_metaclass->has_method('get_mutable_metaclass_name'));
  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     is($transformer, $meta->get_immutable_transformer, '... immutable transformer cache works');
  84     ok(!$meta->make_immutable, '... make immutable now returns nothing');
  85
  86     ok(!$meta->is_mutable, '... our class is no longer mutable');
  87     ok($meta->is_immutable, '... our class is now immutable');
  88
  89     isa_ok($meta, 'Class::MOP::Class');
  90
  91     dies_ok { $meta->add_method()    } '... exception thrown as expected';
  92     dies_ok { $meta->alias_method()  } '... exception thrown as expected';
  93     dies_ok { $meta->remove_method() } '... exception thrown as expected';
  94
  95     dies_ok { $meta->add_attribute()    } '... exception thrown as expected';
  96     dies_ok { $meta->remove_attribute() } '... exception thrown as expected';
  97
  98     dies_ok { $meta->add_package_symbol()    } '... exception thrown as expected';
  99     dies_ok { $meta->remove_package_symbol() } '... exception thrown as expected';
 100
 101     lives_ok { $meta->identifier() } '... no exception for get_package_symbol special case';
 102
 103     my @supers;
 104     lives_ok {
 105         @supers = $meta->superclasses;
 106     } '... got the superclasses okay';
 107
 108     dies_ok { $meta->superclasses([ 'UNIVERSAL' ]) } '... but could not set the superclasses okay';
 109
 110     my $meta_instance;
 111     lives_ok {
 112         $meta_instance = $meta->get_meta_instance;
 113     } '... got the meta instance okay';
 114     isa_ok($meta_instance, 'Class::MOP::Instance');
 115     is($meta_instance, $meta->get_meta_instance, '... and we know it is cached');
 116
 117     my @cpl;
 118     lives_ok {
 119         @cpl = $meta->class_precedence_list;
 120     } '... got the class precedence list okay';
 121     is_deeply(
 122     \@cpl,
 123     [ 'Foo' ],
 124     '... we just have ourselves in the class precedence list');
 125
 126     my @attributes;
 127     lives_ok {
 128         @attributes = $meta->compute_all_applicable_attributes;
 129     } '... got the attribute list okay';
 130     is_deeply(
 131     \@attributes,
 132     [ $meta->get_attribute('bar') ],
 133     '... got the right list of attributes');
 134 }
 135
 136 {
 137     my $meta = Bar->meta;
 138     is($meta->name, 'Bar', '... checking the Bar metaclass');
 139
 140     ok($meta->is_mutable, '... our class is mutable');
 141     ok(!$meta->is_immutable, '... our class is not immutable');
 142
 143     lives_ok {
 144         $meta->make_immutable();
 145     } '... changed Bar to be immutable';
 146
 147     ok(!$meta->make_immutable, '... make immutable now returns nothing');
 148
 149     ok(!$meta->is_mutable, '... our class is no longer mutable');
 150     ok($meta->is_immutable, '... our class is now immutable');
 151
 152     isa_ok($meta, 'Class::MOP::Class');
 153
 154     dies_ok { $meta->add_method()    } '... exception thrown as expected';
 155     dies_ok { $meta->alias_method()  } '... exception thrown as expected';
 156     dies_ok { $meta->remove_method() } '... exception thrown as expected';
 157
 158     dies_ok { $meta->add_attribute()    } '... exception thrown as expected';
 159     dies_ok { $meta->remove_attribute() } '... exception thrown as expected';
 160
 161     dies_ok { $meta->add_package_symbol()    } '... exception thrown as expected';
 162     dies_ok { $meta->remove_package_symbol() } '... exception thrown as expected';
 163
 164     my @supers;
 165     lives_ok {
 166         @supers = $meta->superclasses;
 167     } '... got the superclasses okay';
 168
 169     dies_ok { $meta->superclasses([ 'UNIVERSAL' ]) } '... but could not set the superclasses okay';
 170
 171     my $meta_instance;
 172     lives_ok {
 173         $meta_instance = $meta->get_meta_instance;
 174     } '... got the meta instance okay';
 175     isa_ok($meta_instance, 'Class::MOP::Instance');
 176     is($meta_instance, $meta->get_meta_instance, '... and we know it is cached');
 177
 178     my @cpl;
 179     lives_ok {
 180         @cpl = $meta->class_precedence_list;
 181     } '... got the class precedence list okay';
 182     is_deeply(
 183     \@cpl,
 184     [ 'Bar', 'Foo'],
 185     '... we just have ourselves in the class precedence list');
 186
 187     my @attributes;
 188     lives_ok {
 189         @attributes = $meta->compute_all_applicable_attributes;
 190     } '... got the attribute list okay';
 191     is_deeply(
 192     [ sort { $a->name cmp $b->name } @attributes ],
 193     [ Foo->meta->get_attribute('bar'), $meta->get_attribute('baz') ],
 194     '... got the right list of attributes');
 195 }
 196
 197 {
 198     my $meta = Baz->meta;
 199     is($meta->name, 'Baz', '... checking the Baz metaclass');
 200
 201     ok($meta->is_mutable, '... our class is mutable');
 202     ok(!$meta->is_immutable, '... our class is not immutable');
 203
 204     lives_ok {
 205         $meta->make_immutable();
 206     } '... changed Baz to be immutable';
 207
 208     ok(!$meta->make_immutable, '... make immutable now returns nothing');
 209
 210     ok(!$meta->is_mutable, '... our class is no longer mutable');
 211     ok($meta->is_immutable, '... our class is now immutable');
 212
 213     isa_ok($meta, 'Class::MOP::Class');
 214
 215     dies_ok { $meta->add_method()    } '... exception thrown as expected';
 216     dies_ok { $meta->alias_method()  } '... exception thrown as expected';
 217     dies_ok { $meta->remove_method() } '... exception thrown as expected';
 218
 219     dies_ok { $meta->add_attribute()    } '... exception thrown as expected';
 220     dies_ok { $meta->remove_attribute() } '... exception thrown as expected';
 221
 222     dies_ok { $meta->add_package_symbol()    } '... exception thrown as expected';
 223     dies_ok { $meta->remove_package_symbol() } '... exception thrown as expected';
 224
 225     my @supers;
 226     lives_ok {
 227         @supers = $meta->superclasses;
 228     } '... got the superclasses okay';
 229
 230     dies_ok { $meta->superclasses([ 'UNIVERSAL' ]) } '... but could not set the superclasses okay';
 231
 232     my $meta_instance;
 233     lives_ok {
 234         $meta_instance = $meta->get_meta_instance;
 235     } '... got the meta instance okay';
 236     isa_ok($meta_instance, 'Class::MOP::Instance');
 237     is($meta_instance, $meta->get_meta_instance, '... and we know it is cached');
 238
 239     my @cpl;
 240     lives_ok {
 241         @cpl = $meta->class_precedence_list;
 242     } '... got the class precedence list okay';
 243     is_deeply(
 244     \@cpl,
 245     [ 'Baz', 'Bar', 'Foo'],
 246     '... we just have ourselves in the class precedence list');
 247
 248     my @attributes;
 249     lives_ok {
 250         @attributes = $meta->compute_all_applicable_attributes;
 251     } '... got the attribute list okay';
 252     is_deeply(
 253     [ sort { $a->name cmp $b->name } @attributes ],
 254     [ $meta->get_attribute('bah'), Foo->meta->get_attribute('bar'), Bar->meta->get_attribute('baz') ],
 255     '... got the right list of attributes');
 256 }
 257
 258