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