t/070_immutable_metaclass.t

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