t/070_immutable_metaclass.t

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