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