t/070_immutable_metaclass.t

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