t/070_immutable_metaclass.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::More tests => 86;
   5 use Test::Exception;
   6
   7 use Class::MOP;
   8
   9 {
  10
  11     package Foo;
  12
  13     use strict;
  14     use warnings;
  15     use metaclass;
  16
  17     __PACKAGE__->meta->add_attribute('bar');
  18
  19     package Bar;
  20
  21     use strict;
  22     use warnings;
  23     use metaclass;
  24
  25     __PACKAGE__->meta->superclasses('Foo');
  26
  27     __PACKAGE__->meta->add_attribute('baz');
  28
  29     package Baz;
  30
  31     use strict;
  32     use warnings;
  33     use metaclass;
  34
  35     __PACKAGE__->meta->superclasses('Bar');
  36
  37     __PACKAGE__->meta->add_attribute('bah');
  38 }
  39
  40 {
  41     my $meta = Foo->meta;
  42
  43     my $transformer;
  44     lives_ok { $transformer = $meta->create_immutable_transformer }
  45     "Created immutable transformer";
  46     isa_ok( $transformer, 'Class::MOP::Immutable',
  47         '... transformer isa Class::MOP::Immutable' );
  48     my $methods = $transformer->create_methods_for_immutable_metaclass;
  49
  50     my $immutable_metaclass = $transformer->immutable_metaclass;
  51     is( $transformer->metaclass, $meta,
  52         '... transformer has correct metaclass' );
  53     ok( !$transformer->inlined_constructor,
  54         '... transformer says it did not inline the constructor' );
  55     ok( $immutable_metaclass->is_anon_class,
  56         '... immutable_metaclass is an anonymous class' );
  57
  58     #I don't understand why i need to ->meta here...
  59     my $obj = $immutable_metaclass->name;
  60     ok( !$obj->is_mutable,  '... immutable_metaclass is not mutable' );
  61     ok( $obj->is_immutable, '... immutable_metaclass is immutable' );
  62     ok( !$obj->make_immutable,
  63         '... immutable_metaclass make_mutable is noop' );
  64     is( $obj->meta, $immutable_metaclass,
  65         '... immutable_metaclass meta hack works' );
  66
  67     is_deeply(
  68         [ $immutable_metaclass->superclasses ],
  69         [ Scalar::Util::blessed($meta) ],
  70         '... immutable_metaclass superclasses are correct'
  71     );
  72     ok(
  73         $immutable_metaclass->has_method('get_mutable_metaclass_name'),
  74         'immutable metaclass has get_mutable_metaclass_name method'
  75     );
  76
  77 }
  78
  79 {
  80     my $meta = Foo->meta;
  81     is( $meta->name, 'Foo', '... checking the Foo metaclass' );
  82
  83     ok( $meta->is_mutable,    '... our class is mutable' );
  84     ok( !$meta->is_immutable, '... our class is not immutable' );
  85
  86     my $transformer = $meta->get_immutable_transformer;
  87
  88     lives_ok {
  89         $meta->make_immutable();
  90     }
  91     '... changed Foo to be immutable';
  92
  93     ok( $transformer->inlined_constructor,
  94         '... transformer says it did inline the constructor' );
  95     is( $transformer, $meta->get_immutable_transformer,
  96         '... immutable transformer cache works' );
  97     ok( !$meta->make_immutable, '... make immutable now returns nothing' );
  98
  99     ok( !$meta->is_mutable,  '... our class is no longer mutable' );
 100     ok( $meta->is_immutable, '... our class is now immutable' );
 101
 102     isa_ok( $meta, 'Class::MOP::Class' );
 103
 104     dies_ok { $meta->add_method() } '... exception thrown as expected';
 105     dies_ok { $meta->alias_method() } '... exception thrown as expected';
 106     dies_ok { $meta->remove_method() } '... exception thrown as expected';
 107
 108     dies_ok { $meta->add_attribute() } '... exception thrown as expected';
 109     dies_ok { $meta->remove_attribute() } '... exception thrown as expected';
 110
 111     dies_ok { $meta->add_package_symbol() }
 112     '... exception thrown as expected';
 113     dies_ok { $meta->remove_package_symbol() }
 114     '... exception thrown as expected';
 115
 116     lives_ok { $meta->identifier() }
 117     '... no exception for get_package_symbol special case';
 118
 119     my @supers;
 120     lives_ok {
 121         @supers = $meta->superclasses;
 122     }
 123     '... got the superclasses okay';
 124
 125     dies_ok { $meta->superclasses( ['UNIVERSAL'] ) }
 126     '... but could not set the superclasses okay';
 127
 128     my $meta_instance;
 129     lives_ok {
 130         $meta_instance = $meta->get_meta_instance;
 131     }
 132     '... got the meta instance okay';
 133     isa_ok( $meta_instance, 'Class::MOP::Instance' );
 134     is( $meta_instance, $meta->get_meta_instance,
 135         '... and we know it is cached' );
 136
 137     my @cpl;
 138     lives_ok {
 139         @cpl = $meta->class_precedence_list;
 140     }
 141     '... got the class precedence list okay';
 142     is_deeply(
 143         \@cpl,
 144         ['Foo'],
 145         '... we just have ourselves in the class precedence list'
 146     );
 147
 148     my @attributes;
 149     lives_ok {
 150         @attributes = $meta->compute_all_applicable_attributes;
 151     }
 152     '... got the attribute list okay';
 153     is_deeply(
 154         \@attributes,
 155         [ $meta->get_attribute('bar') ],
 156         '... got the right list of attributes'
 157     );
 158 }
 159
 160 {
 161     my $meta = Bar->meta;
 162     is( $meta->name, 'Bar', '... checking the Bar metaclass' );
 163
 164     ok( $meta->is_mutable,    '... our class is mutable' );
 165     ok( !$meta->is_immutable, '... our class is not immutable' );
 166
 167     lives_ok {
 168         $meta->make_immutable();
 169     }
 170     '... changed Bar to be immutable';
 171
 172     ok( !$meta->make_immutable, '... make immutable now returns nothing' );
 173
 174     ok( !$meta->is_mutable,  '... our class is no longer mutable' );
 175     ok( $meta->is_immutable, '... our class is now immutable' );
 176
 177     isa_ok( $meta, 'Class::MOP::Class' );
 178
 179     dies_ok { $meta->add_method() } '... exception thrown as expected';
 180     dies_ok { $meta->alias_method() } '... exception thrown as expected';
 181     dies_ok { $meta->remove_method() } '... exception thrown as expected';
 182
 183     dies_ok { $meta->add_attribute() } '... exception thrown as expected';
 184     dies_ok { $meta->remove_attribute() } '... exception thrown as expected';
 185
 186     dies_ok { $meta->add_package_symbol() }
 187     '... exception thrown as expected';
 188     dies_ok { $meta->remove_package_symbol() }
 189     '... exception thrown as expected';
 190
 191     my @supers;
 192     lives_ok {
 193         @supers = $meta->superclasses;
 194     }
 195     '... got the superclasses okay';
 196
 197     dies_ok { $meta->superclasses( ['UNIVERSAL'] ) }
 198     '... but could not set the superclasses okay';
 199
 200     my $meta_instance;
 201     lives_ok {
 202         $meta_instance = $meta->get_meta_instance;
 203     }
 204     '... got the meta instance okay';
 205     isa_ok( $meta_instance, 'Class::MOP::Instance' );
 206     is( $meta_instance, $meta->get_meta_instance,
 207         '... and we know it is cached' );
 208
 209     my @cpl;
 210     lives_ok {
 211         @cpl = $meta->class_precedence_list;
 212     }
 213     '... got the class precedence list okay';
 214     is_deeply(
 215         \@cpl,
 216         [ 'Bar', 'Foo' ],
 217         '... we just have ourselves in the class precedence list'
 218     );
 219
 220     my @attributes;
 221     lives_ok {
 222         @attributes = $meta->compute_all_applicable_attributes;
 223     }
 224     '... got the attribute list okay';
 225     is_deeply(
 226         [ sort { $a->name cmp $b->name } @attributes ],
 227         [ Foo->meta->get_attribute('bar'), $meta->get_attribute('baz') ],
 228         '... got the right list of attributes'
 229     );
 230 }
 231
 232 {
 233     my $meta = Baz->meta;
 234     is( $meta->name, 'Baz', '... checking the Baz metaclass' );
 235
 236     ok( $meta->is_mutable,    '... our class is mutable' );
 237     ok( !$meta->is_immutable, '... our class is not immutable' );
 238
 239     lives_ok {
 240         $meta->make_immutable();
 241     }
 242     '... changed Baz to be immutable';
 243
 244     ok( !$meta->make_immutable, '... make immutable now returns nothing' );
 245
 246     ok( !$meta->is_mutable,  '... our class is no longer mutable' );
 247     ok( $meta->is_immutable, '... our class is now immutable' );
 248
 249     isa_ok( $meta, 'Class::MOP::Class' );
 250
 251     dies_ok { $meta->add_method() } '... exception thrown as expected';
 252     dies_ok { $meta->alias_method() } '... exception thrown as expected';
 253     dies_ok { $meta->remove_method() } '... exception thrown as expected';
 254
 255     dies_ok { $meta->add_attribute() } '... exception thrown as expected';
 256     dies_ok { $meta->remove_attribute() } '... exception thrown as expected';
 257
 258     dies_ok { $meta->add_package_symbol() }
 259     '... exception thrown as expected';
 260     dies_ok { $meta->remove_package_symbol() }
 261     '... exception thrown as expected';
 262
 263     my @supers;
 264     lives_ok {
 265         @supers = $meta->superclasses;
 266     }
 267     '... got the superclasses okay';
 268
 269     dies_ok { $meta->superclasses( ['UNIVERSAL'] ) }
 270     '... but could not set the superclasses okay';
 271
 272     my $meta_instance;
 273     lives_ok {
 274         $meta_instance = $meta->get_meta_instance;
 275     }
 276     '... got the meta instance okay';
 277     isa_ok( $meta_instance, 'Class::MOP::Instance' );
 278     is( $meta_instance, $meta->get_meta_instance,
 279         '... and we know it is cached' );
 280
 281     my @cpl;
 282     lives_ok {
 283         @cpl = $meta->class_precedence_list;
 284     }
 285     '... got the class precedence list okay';
 286     is_deeply(
 287         \@cpl,
 288         [ 'Baz', 'Bar', 'Foo' ],
 289         '... we just have ourselves in the class precedence list'
 290     );
 291
 292     my @attributes;
 293     lives_ok {
 294         @attributes = $meta->compute_all_applicable_attributes;
 295     }
 296     '... got the attribute list okay';
 297     is_deeply(
 298         [ sort { $a->name cmp $b->name } @attributes ],
 299         [
 300             $meta->get_attribute('bah'), Foo->meta->get_attribute('bar'),
 301             Bar->meta->get_attribute('baz')
 302         ],
 303         '... got the right list of attributes'
 304     );
 305 }