t/070_immutable_metaclass.t

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