t/070_immutable_metaclass.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::More tests => 73;
   5 use Test::Exception;
   6
   7 use Class::MOP;
   8
   9 {
  10     package Foo;
  11
  12     use strict;
  13     use warnings;
  14     use metaclass;
  15
  16     __PACKAGE__->meta->add_attribute('bar');
  17
  18     package Bar;
  19
  20     use strict;
  21     use warnings;
  22     use metaclass;
  23
  24     __PACKAGE__->meta->superclasses('Foo');
  25
  26     __PACKAGE__->meta->add_attribute('baz');
  27
  28     package Baz;
  29
  30     use strict;
  31     use warnings;
  32     use metaclass;
  33
  34     __PACKAGE__->meta->superclasses('Bar');
  35
  36     __PACKAGE__->meta->add_attribute('bah');
  37 }
  38
  39 {
  40     my $meta = Foo->meta;
  41     my $original_metaclass_name = ref $meta;
  42
  43     $meta->make_immutable;
  44
  45     my $immutable_metaclass = $meta->_immutable_metaclass->meta;
  46
  47     my $immutable_class_name = $immutable_metaclass->name;
  48
  49     ok( !$immutable_class_name->is_mutable,  '... immutable_metaclass is not mutable' );
  50     ok( $immutable_class_name->is_immutable, '... immutable_metaclass is immutable' );
  51     is( $immutable_class_name->meta, $immutable_metaclass,
  52         '... immutable_metaclass meta hack works' );
  53
  54     isa_ok( $meta, "Class::MOP::Class" );
  55 }
  56
  57 {
  58     my $meta = Foo->meta;
  59     is( $meta->name, 'Foo', '... checking the Foo metaclass' );
  60
  61     ok( !$meta->is_mutable,    '... our class is not mutable' );
  62     ok( $meta->is_immutable, '... our class is immutable' );
  63
  64     isa_ok( $meta, 'Class::MOP::Class' );
  65
  66     dies_ok { $meta->add_method() } '... exception thrown as expected';
  67     dies_ok { $meta->alias_method() } '... exception thrown as expected';
  68     dies_ok { $meta->remove_method() } '... exception thrown as expected';
  69
  70     dies_ok { $meta->add_attribute() } '... exception thrown as expected';
  71     dies_ok { $meta->remove_attribute() } '... exception thrown as expected';
  72
  73     dies_ok { $meta->add_package_symbol() }
  74     '... exception thrown as expected';
  75     dies_ok { $meta->remove_package_symbol() }
  76     '... exception thrown as expected';
  77
  78     lives_ok { $meta->identifier() }
  79     '... no exception for get_package_symbol special case';
  80
  81     my @supers;
  82     lives_ok {
  83         @supers = $meta->superclasses;
  84     }
  85     '... got the superclasses okay';
  86
  87     dies_ok { $meta->superclasses( ['UNIVERSAL'] ) }
  88     '... but could not set the superclasses okay';
  89
  90     my $meta_instance;
  91     lives_ok {
  92         $meta_instance = $meta->get_meta_instance;
  93     }
  94     '... got the meta instance okay';
  95     isa_ok( $meta_instance, 'Class::MOP::Instance' );
  96     is( $meta_instance, $meta->get_meta_instance,
  97         '... and we know it is cached' );
  98
  99     my @cpl;
 100     lives_ok {
 101         @cpl = $meta->class_precedence_list;
 102     }
 103     '... got the class precedence list okay';
 104     is_deeply(
 105         \@cpl,
 106         ['Foo'],
 107         '... we just have ourselves in the class precedence list'
 108     );
 109
 110     my @attributes;
 111     lives_ok {
 112         @attributes = $meta->get_all_attributes;
 113     }
 114     '... got the attribute list okay';
 115     is_deeply(
 116         \@attributes,
 117         [ $meta->get_attribute('bar') ],
 118         '... got the right list of attributes'
 119     );
 120 }
 121
 122 {
 123     my $meta = Bar->meta;
 124     is( $meta->name, 'Bar', '... checking the Bar metaclass' );
 125
 126     ok( $meta->is_mutable,    '... our class is mutable' );
 127     ok( !$meta->is_immutable, '... our class is not immutable' );
 128
 129     lives_ok {
 130         $meta->make_immutable();
 131     }
 132     '... changed Bar to be immutable';
 133
 134     ok( !$meta->make_immutable, '... make immutable now returns nothing' );
 135
 136     ok( !$meta->is_mutable,  '... our class is no longer mutable' );
 137     ok( $meta->is_immutable, '... our class is now immutable' );
 138
 139     isa_ok( $meta, 'Class::MOP::Class' );
 140
 141     dies_ok { $meta->add_method() } '... exception thrown as expected';
 142     dies_ok { $meta->alias_method() } '... exception thrown as expected';
 143     dies_ok { $meta->remove_method() } '... exception thrown as expected';
 144
 145     dies_ok { $meta->add_attribute() } '... exception thrown as expected';
 146     dies_ok { $meta->remove_attribute() } '... exception thrown as expected';
 147
 148     dies_ok { $meta->add_package_symbol() }
 149     '... exception thrown as expected';
 150     dies_ok { $meta->remove_package_symbol() }
 151     '... exception thrown as expected';
 152
 153     my @supers;
 154     lives_ok {
 155         @supers = $meta->superclasses;
 156     }
 157     '... got the superclasses okay';
 158
 159     dies_ok { $meta->superclasses( ['UNIVERSAL'] ) }
 160     '... but could not set the superclasses okay';
 161
 162     my $meta_instance;
 163     lives_ok {
 164         $meta_instance = $meta->get_meta_instance;
 165     }
 166     '... got the meta instance okay';
 167     isa_ok( $meta_instance, 'Class::MOP::Instance' );
 168     is( $meta_instance, $meta->get_meta_instance,
 169         '... and we know it is cached' );
 170
 171     my @cpl;
 172     lives_ok {
 173         @cpl = $meta->class_precedence_list;
 174     }
 175     '... got the class precedence list okay';
 176     is_deeply(
 177         \@cpl,
 178         [ 'Bar', 'Foo' ],
 179         '... we just have ourselves in the class precedence list'
 180     );
 181
 182     my @attributes;
 183     lives_ok {
 184         @attributes = $meta->get_all_attributes;
 185     }
 186     '... got the attribute list okay';
 187     is_deeply(
 188         [ sort { $a->name cmp $b->name } @attributes ],
 189         [ Foo->meta->get_attribute('bar'), $meta->get_attribute('baz') ],
 190         '... got the right list of attributes'
 191     );
 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     }
 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() }
 221     '... exception thrown as expected';
 222     dies_ok { $meta->remove_package_symbol() }
 223     '... exception thrown as expected';
 224
 225     my @supers;
 226     lives_ok {
 227         @supers = $meta->superclasses;
 228     }
 229     '... got the superclasses okay';
 230
 231     dies_ok { $meta->superclasses( ['UNIVERSAL'] ) }
 232     '... but could not set the superclasses okay';
 233
 234     my $meta_instance;
 235     lives_ok {
 236         $meta_instance = $meta->get_meta_instance;
 237     }
 238     '... got the meta instance okay';
 239     isa_ok( $meta_instance, 'Class::MOP::Instance' );
 240     is( $meta_instance, $meta->get_meta_instance,
 241         '... and we know it is cached' );
 242
 243     my @cpl;
 244     lives_ok {
 245         @cpl = $meta->class_precedence_list;
 246     }
 247     '... got the class precedence list okay';
 248     is_deeply(
 249         \@cpl,
 250         [ 'Baz', 'Bar', 'Foo' ],
 251         '... we just have ourselves in the class precedence list'
 252     );
 253
 254     my @attributes;
 255     lives_ok {
 256         @attributes = $meta->get_all_attributes;
 257     }
 258     '... got the attribute list okay';
 259     is_deeply(
 260         [ sort { $a->name cmp $b->name } @attributes ],
 261         [
 262             $meta->get_attribute('bah'), Foo->meta->get_attribute('bar'),
 263             Bar->meta->get_attribute('baz')
 264         ],
 265         '... got the right list of attributes'
 266     );
 267 }