t/001_cmop/070_immutable_metaclass.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::More;
   5 use Test::Fatal;
   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     is_deeply(
  44         { $meta->immutable_options }, {},
  45         'immutable_options is empty before a class is made_immutable'
  46     );
  47
  48     $meta->make_immutable;
  49
  50     my $immutable_metaclass = $meta->_immutable_metaclass->meta;
  51
  52     my $immutable_class_name = $immutable_metaclass->name;
  53
  54     ok( !$immutable_class_name->is_mutable,  '... immutable_metaclass is not mutable' );
  55     ok( $immutable_class_name->is_immutable, '... immutable_metaclass is immutable' );
  56     is( $immutable_class_name->meta, $immutable_metaclass,
  57         '... immutable_metaclass meta hack works' );
  58
  59     is_deeply(
  60         { $meta->immutable_options },
  61         {
  62             inline_accessors   => 1,
  63             inline_constructor => 1,
  64             inline_destructor  => 0,
  65             debug              => 0,
  66             immutable_trait    => 'Class::MOP::Class::Immutable::Trait',
  67             constructor_name   => 'new',
  68             constructor_class  => 'Class::MOP::Method::Constructor',
  69             destructor_class   => undef,
  70         },
  71         'immutable_options is empty before a class is made_immutable'
  72     );
  73
  74     isa_ok( $meta, "Class::MOP::Class" );
  75 }
  76
  77 {
  78     my $meta = Foo->meta;
  79     is( $meta->name, 'Foo', '... checking the Foo metaclass' );
  80
  81     ok( !$meta->is_mutable,    '... our class is not mutable' );
  82     ok( $meta->is_immutable, '... our class is immutable' );
  83
  84     isa_ok( $meta, 'Class::MOP::Class' );
  85
  86     isnt( exception { $meta->add_method() }, undef, '... exception thrown as expected' );
  87     isnt( exception { $meta->alias_method() }, undef, '... exception thrown as expected' );
  88     isnt( exception { $meta->remove_method() }, undef, '... exception thrown as expected' );
  89
  90     isnt( exception { $meta->add_attribute() }, undef, '... exception thrown as expected' );
  91     isnt( exception { $meta->remove_attribute() }, undef, '... exception thrown as expected' );
  92
  93     isnt( exception { $meta->add_package_symbol() }, undef, '... exception thrown as expected' );
  94     isnt( exception { $meta->remove_package_symbol() }, undef, '... exception thrown as expected' );
  95
  96     is( exception { $meta->identifier() }, undef, '... no exception for get_package_symbol special case' );
  97
  98     my @supers;
  99     is( exception {
 100         @supers = $meta->superclasses;
 101     }, undef, '... got the superclasses okay' );
 102
 103     isnt( exception { $meta->superclasses( ['UNIVERSAL'] ) }, undef, '... but could not set the superclasses okay' );
 104
 105     my $meta_instance;
 106     is( exception {
 107         $meta_instance = $meta->get_meta_instance;
 108     }, undef, '... got the meta instance okay' );
 109     isa_ok( $meta_instance, 'Class::MOP::Instance' );
 110     is( $meta_instance, $meta->get_meta_instance,
 111         '... and we know it is cached' );
 112
 113     my @cpl;
 114     is( exception {
 115         @cpl = $meta->class_precedence_list;
 116     }, undef, '... got the class precedence list okay' );
 117     is_deeply(
 118         \@cpl,
 119         ['Foo'],
 120         '... we just have ourselves in the class precedence list'
 121     );
 122
 123     my @attributes;
 124     is( exception {
 125         @attributes = $meta->get_all_attributes;
 126     }, undef, '... 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 {
 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     is( exception {
 142         $meta->make_immutable();
 143     }, undef, '... 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     isnt( exception { $meta->add_method() }, undef, '... exception thrown as expected' );
 153     isnt( exception { $meta->alias_method() }, undef, '... exception thrown as expected' );
 154     isnt( exception { $meta->remove_method() }, undef, '... exception thrown as expected' );
 155
 156     isnt( exception { $meta->add_attribute() }, undef, '... exception thrown as expected' );
 157     isnt( exception { $meta->remove_attribute() }, undef, '... exception thrown as expected' );
 158
 159     isnt( exception { $meta->add_package_symbol() }, undef, '... exception thrown as expected' );
 160     isnt( exception { $meta->remove_package_symbol() }, undef, '... exception thrown as expected' );
 161
 162     my @supers;
 163     is( exception {
 164         @supers = $meta->superclasses;
 165     }, undef, '... got the superclasses okay' );
 166
 167     isnt( exception { $meta->superclasses( ['UNIVERSAL'] ) }, undef, '... but could not set the superclasses okay' );
 168
 169     my $meta_instance;
 170     is( exception {
 171         $meta_instance = $meta->get_meta_instance;
 172     }, undef, '... got the meta instance okay' );
 173     isa_ok( $meta_instance, 'Class::MOP::Instance' );
 174     is( $meta_instance, $meta->get_meta_instance,
 175         '... and we know it is cached' );
 176
 177     my @cpl;
 178     is( exception {
 179         @cpl = $meta->class_precedence_list;
 180     }, undef, '... got the class precedence list okay' );
 181     is_deeply(
 182         \@cpl,
 183         [ 'Bar', 'Foo' ],
 184         '... we just have ourselves in the class precedence list'
 185     );
 186
 187     my @attributes;
 188     is( exception {
 189         @attributes = $meta->get_all_attributes;
 190     }, undef, '... 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     is( exception {
 206         $meta->make_immutable();
 207     }, undef, '... changed Baz to be immutable' );
 208
 209     ok( !$meta->make_immutable, '... make immutable now returns nothing' );
 210
 211     ok( !$meta->is_mutable,  '... our class is no longer mutable' );
 212     ok( $meta->is_immutable, '... our class is now immutable' );
 213
 214     isa_ok( $meta, 'Class::MOP::Class' );
 215
 216     isnt( exception { $meta->add_method() }, undef, '... exception thrown as expected' );
 217     isnt( exception { $meta->alias_method() }, undef, '... exception thrown as expected' );
 218     isnt( exception { $meta->remove_method() }, undef, '... exception thrown as expected' );
 219
 220     isnt( exception { $meta->add_attribute() }, undef, '... exception thrown as expected' );
 221     isnt( exception { $meta->remove_attribute() }, undef, '... exception thrown as expected' );
 222
 223     isnt( exception { $meta->add_package_symbol() }, undef, '... exception thrown as expected' );
 224     isnt( exception { $meta->remove_package_symbol() }, undef, '... exception thrown as expected' );
 225
 226     my @supers;
 227     is( exception {
 228         @supers = $meta->superclasses;
 229     }, undef, '... got the superclasses okay' );
 230
 231     isnt( exception { $meta->superclasses( ['UNIVERSAL'] ) }, undef, '... but could not set the superclasses okay' );
 232
 233     my $meta_instance;
 234     is( exception {
 235         $meta_instance = $meta->get_meta_instance;
 236     }, undef, '... got the meta instance okay' );
 237     isa_ok( $meta_instance, 'Class::MOP::Instance' );
 238     is( $meta_instance, $meta->get_meta_instance,
 239         '... and we know it is cached' );
 240
 241     my @cpl;
 242     is( exception {
 243         @cpl = $meta->class_precedence_list;
 244     }, undef, '... got the class precedence list okay' );
 245     is_deeply(
 246         \@cpl,
 247         [ 'Baz', 'Bar', 'Foo' ],
 248         '... we just have ourselves in the class precedence list'
 249     );
 250
 251     my @attributes;
 252     is( exception {
 253         @attributes = $meta->get_all_attributes;
 254     }, undef, '... got the attribute list okay' );
 255     is_deeply(
 256         [ sort { $a->name cmp $b->name } @attributes ],
 257         [
 258             $meta->get_attribute('bah'), Foo->meta->get_attribute('bar'),
 259             Bar->meta->get_attribute('baz')
 260         ],
 261         '... got the right list of attributes'
 262     );
 263 }
 264
 265 # This test probably needs to go last since it will muck up the Foo class
 266 {
 267     my $meta = Foo->meta;
 268
 269     $meta->make_mutable;
 270     $meta->make_immutable(
 271         inline_accessors   => 0,
 272         inline_constructor => 0,
 273         constructor_name   => 'newer',
 274     );
 275
 276     is_deeply(
 277         { $meta->immutable_options },
 278         {
 279             inline_accessors   => 0,
 280             inline_constructor => 0,
 281             inline_destructor  => 0,
 282             debug              => 0,
 283             immutable_trait    => 'Class::MOP::Class::Immutable::Trait',
 284             constructor_name   => 'newer',
 285             constructor_class  => 'Class::MOP::Method::Constructor',
 286             destructor_class   => undef,
 287         },
 288         'custom immutable_options are returned by immutable_options accessor'
 289     );
 290 }
 291
 292 done_testing;