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