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