t/070_immutable_metaclass.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::More tests => 76;
   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     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     dies_ok { $meta->add_method() } '... exception thrown as expected';
  87     dies_ok { $meta->alias_method() } '... exception thrown as expected';
  88     dies_ok { $meta->remove_method() } '... exception thrown as expected';
  89
  90     dies_ok { $meta->add_attribute() } '... exception thrown as expected';
  91     dies_ok { $meta->remove_attribute() } '... exception thrown as expected';
  92
  93     dies_ok { $meta->add_package_symbol() }
  94     '... exception thrown as expected';
  95     dies_ok { $meta->remove_package_symbol() }
  96     '... exception thrown as expected';
  97
  98     lives_ok { $meta->identifier() }
  99     '... no exception for get_package_symbol special case';
 100
 101     my @supers;
 102     lives_ok {
 103         @supers = $meta->superclasses;
 104     }
 105     '... got the superclasses okay';
 106
 107     dies_ok { $meta->superclasses( ['UNIVERSAL'] ) }
 108     '... but could not set the superclasses okay';
 109
 110     my $meta_instance;
 111     lives_ok {
 112         $meta_instance = $meta->get_meta_instance;
 113     }
 114     '... got the meta instance okay';
 115     isa_ok( $meta_instance, 'Class::MOP::Instance' );
 116     is( $meta_instance, $meta->get_meta_instance,
 117         '... and we know it is cached' );
 118
 119     my @cpl;
 120     lives_ok {
 121         @cpl = $meta->class_precedence_list;
 122     }
 123     '... got the class precedence list okay';
 124     is_deeply(
 125         \@cpl,
 126         ['Foo'],
 127         '... we just have ourselves in the class precedence list'
 128     );
 129
 130     my @attributes;
 131     lives_ok {
 132         @attributes = $meta->get_all_attributes;
 133     }
 134     '... got the attribute list okay';
 135     is_deeply(
 136         \@attributes,
 137         [ $meta->get_attribute('bar') ],
 138         '... got the right list of attributes'
 139     );
 140 }
 141
 142 {
 143     my $meta = Bar->meta;
 144     is( $meta->name, 'Bar', '... checking the Bar metaclass' );
 145
 146     ok( $meta->is_mutable,    '... our class is mutable' );
 147     ok( !$meta->is_immutable, '... our class is not immutable' );
 148
 149     lives_ok {
 150         $meta->make_immutable();
 151     }
 152     '... changed Bar to be immutable';
 153
 154     ok( !$meta->make_immutable, '... make immutable now returns nothing' );
 155
 156     ok( !$meta->is_mutable,  '... our class is no longer mutable' );
 157     ok( $meta->is_immutable, '... our class is now immutable' );
 158
 159     isa_ok( $meta, 'Class::MOP::Class' );
 160
 161     dies_ok { $meta->add_method() } '... exception thrown as expected';
 162     dies_ok { $meta->alias_method() } '... exception thrown as expected';
 163     dies_ok { $meta->remove_method() } '... exception thrown as expected';
 164
 165     dies_ok { $meta->add_attribute() } '... exception thrown as expected';
 166     dies_ok { $meta->remove_attribute() } '... exception thrown as expected';
 167
 168     dies_ok { $meta->add_package_symbol() }
 169     '... exception thrown as expected';
 170     dies_ok { $meta->remove_package_symbol() }
 171     '... exception thrown as expected';
 172
 173     my @supers;
 174     lives_ok {
 175         @supers = $meta->superclasses;
 176     }
 177     '... got the superclasses okay';
 178
 179     dies_ok { $meta->superclasses( ['UNIVERSAL'] ) }
 180     '... but could not set the superclasses okay';
 181
 182     my $meta_instance;
 183     lives_ok {
 184         $meta_instance = $meta->get_meta_instance;
 185     }
 186     '... got the meta instance okay';
 187     isa_ok( $meta_instance, 'Class::MOP::Instance' );
 188     is( $meta_instance, $meta->get_meta_instance,
 189         '... and we know it is cached' );
 190
 191     my @cpl;
 192     lives_ok {
 193         @cpl = $meta->class_precedence_list;
 194     }
 195     '... got the class precedence list okay';
 196     is_deeply(
 197         \@cpl,
 198         [ 'Bar', 'Foo' ],
 199         '... we just have ourselves in the class precedence list'
 200     );
 201
 202     my @attributes;
 203     lives_ok {
 204         @attributes = $meta->get_all_attributes;
 205     }
 206     '... got the attribute list okay';
 207     is_deeply(
 208         [ sort { $a->name cmp $b->name } @attributes ],
 209         [ Foo->meta->get_attribute('bar'), $meta->get_attribute('baz') ],
 210         '... got the right list of attributes'
 211     );
 212 }
 213
 214 {
 215     my $meta = Baz->meta;
 216     is( $meta->name, 'Baz', '... checking the Baz metaclass' );
 217
 218     ok( $meta->is_mutable,    '... our class is mutable' );
 219     ok( !$meta->is_immutable, '... our class is not immutable' );
 220
 221     lives_ok {
 222         $meta->make_immutable();
 223     }
 224     '... changed Baz to be immutable';
 225
 226     ok( !$meta->make_immutable, '... make immutable now returns nothing' );
 227
 228     ok( !$meta->is_mutable,  '... our class is no longer mutable' );
 229     ok( $meta->is_immutable, '... our class is now immutable' );
 230
 231     isa_ok( $meta, 'Class::MOP::Class' );
 232
 233     dies_ok { $meta->add_method() } '... exception thrown as expected';
 234     dies_ok { $meta->alias_method() } '... exception thrown as expected';
 235     dies_ok { $meta->remove_method() } '... exception thrown as expected';
 236
 237     dies_ok { $meta->add_attribute() } '... exception thrown as expected';
 238     dies_ok { $meta->remove_attribute() } '... exception thrown as expected';
 239
 240     dies_ok { $meta->add_package_symbol() }
 241     '... exception thrown as expected';
 242     dies_ok { $meta->remove_package_symbol() }
 243     '... exception thrown as expected';
 244
 245     my @supers;
 246     lives_ok {
 247         @supers = $meta->superclasses;
 248     }
 249     '... got the superclasses okay';
 250
 251     dies_ok { $meta->superclasses( ['UNIVERSAL'] ) }
 252     '... but could not set the superclasses okay';
 253
 254     my $meta_instance;
 255     lives_ok {
 256         $meta_instance = $meta->get_meta_instance;
 257     }
 258     '... got the meta instance okay';
 259     isa_ok( $meta_instance, 'Class::MOP::Instance' );
 260     is( $meta_instance, $meta->get_meta_instance,
 261         '... and we know it is cached' );
 262
 263     my @cpl;
 264     lives_ok {
 265         @cpl = $meta->class_precedence_list;
 266     }
 267     '... got the class precedence list okay';
 268     is_deeply(
 269         \@cpl,
 270         [ 'Baz', 'Bar', 'Foo' ],
 271         '... we just have ourselves in the class precedence list'
 272     );
 273
 274     my @attributes;
 275     lives_ok {
 276         @attributes = $meta->get_all_attributes;
 277     }
 278     '... got the attribute list okay';
 279     is_deeply(
 280         [ sort { $a->name cmp $b->name } @attributes ],
 281         [
 282             $meta->get_attribute('bah'), Foo->meta->get_attribute('bar'),
 283             Bar->meta->get_attribute('baz')
 284         ],
 285         '... got the right list of attributes'
 286     );
 287 }
 288
 289 # This test probably needs to go last since it will muck up the Foo class
 290 {
 291     my $meta = Foo->meta;
 292
 293     $meta->make_mutable;
 294     $meta->make_immutable(
 295         inline_accessors   => 0,
 296         inline_constructor => 0,
 297         constructor_name   => 'newer',
 298     );
 299
 300     is_deeply(
 301         { $meta->immutable_options },
 302         {
 303             inline_accessors   => 0,
 304             inline_constructor => 0,
 305             inline_destructor  => 0,
 306             debug              => 0,
 307             immutable_trait    => 'Class::MOP::Class::Immutable::Trait',
 308             constructor_name   => 'newer',
 309             constructor_class  => 'Class::MOP::Method::Constructor',
 310             destructor_class   => undef,
 311         },
 312         'custom immutable_options are returned by immutable_options accessor'
 313     );
 314 }