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