t/070_immutable_metaclass.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 73;
   7 use Test::Exception;
   8
   9 BEGIN {
  10     use_ok('Class::MOP');
  11 }
  12
  13 {
  14     package Foo;
  15
  16     use strict;
  17     use warnings;
  18     use metaclass;
  19
  20     __PACKAGE__->meta->add_attribute('bar');
  21
  22     package Bar;
  23
  24     use strict;
  25     use warnings;
  26     use metaclass;
  27
  28     __PACKAGE__->meta->superclasses('Foo');
  29
  30     __PACKAGE__->meta->add_attribute('baz');
  31
  32     package Baz;
  33
  34     use strict;
  35     use warnings;
  36     use metaclass;
  37
  38     __PACKAGE__->meta->superclasses('Bar');
  39
  40     __PACKAGE__->meta->add_attribute('bah');
  41 }
  42
  43 {
  44     my $meta = Foo->meta;
  45     is($meta->name, 'Foo', '... checking the Foo metaclass');
  46
  47     ok($meta->is_mutable, '... our class is mutable');
  48     ok(!$meta->is_immutable, '... our class is not immutable');
  49
  50     lives_ok {
  51         $meta->make_immutable();
  52     } '... changed Foo to be immutable';
  53
  54     ok(!$meta->make_immutable, '... make immutable now returns nothing');
  55
  56     ok(!$meta->is_mutable, '... our class is no longer mutable');
  57     ok($meta->is_immutable, '... our class is now immutable');
  58
  59     isa_ok($meta, 'Class::MOP::Class');
  60
  61     dies_ok { $meta->add_method()    } '... exception thrown as expected';
  62     dies_ok { $meta->alias_method()  } '... exception thrown as expected';
  63     dies_ok { $meta->remove_method() } '... exception thrown as expected';
  64
  65     dies_ok { $meta->add_attribute()    } '... exception thrown as expected';
  66     dies_ok { $meta->remove_attribute() } '... exception thrown as expected';
  67
  68     dies_ok { $meta->add_package_symbol()    } '... exception thrown as expected';
  69     dies_ok { $meta->remove_package_symbol() } '... exception thrown as expected';
  70
  71     my @supers;
  72     lives_ok {
  73         @supers = $meta->superclasses;
  74     } '... got the superclasses okay';
  75
  76     dies_ok { $meta->superclasses([ 'UNIVERSAL' ]) } '... but could not set the superclasses okay';
  77
  78     my $meta_instance;
  79     lives_ok {
  80         $meta_instance = $meta->get_meta_instance;
  81     } '... got the meta instance okay';
  82     isa_ok($meta_instance, 'Class::MOP::Instance');
  83     is($meta_instance, $meta->get_meta_instance, '... and we know it is cached');
  84
  85     my @cpl;
  86     lives_ok {
  87         @cpl = $meta->class_precedence_list;
  88     } '... got the class precedence list okay';
  89     is_deeply(
  90     \@cpl,
  91     [ 'Foo' ],
  92     '... we just have ourselves in the class precedence list');
  93
  94     my @attributes;
  95     lives_ok {
  96         @attributes = $meta->compute_all_applicable_attributes;
  97     } '... got the attribute list okay';
  98     is_deeply(
  99     \@attributes,
 100     [ $meta->get_attribute('bar') ],
 101     '... got the right list of attributes');
 102 }
 103
 104 {
 105     my $meta = Bar->meta;
 106     is($meta->name, 'Bar', '... checking the Bar metaclass');
 107
 108     ok($meta->is_mutable, '... our class is mutable');
 109     ok(!$meta->is_immutable, '... our class is not immutable');
 110
 111     lives_ok {
 112         $meta->make_immutable();
 113     } '... changed Bar to be immutable';
 114
 115     ok(!$meta->make_immutable, '... make immutable now returns nothing');
 116
 117     ok(!$meta->is_mutable, '... our class is no longer mutable');
 118     ok($meta->is_immutable, '... our class is now immutable');
 119
 120     isa_ok($meta, 'Class::MOP::Class');
 121
 122     dies_ok { $meta->add_method()    } '... exception thrown as expected';
 123     dies_ok { $meta->alias_method()  } '... exception thrown as expected';
 124     dies_ok { $meta->remove_method() } '... exception thrown as expected';
 125
 126     dies_ok { $meta->add_attribute()    } '... exception thrown as expected';
 127     dies_ok { $meta->remove_attribute() } '... exception thrown as expected';
 128
 129     dies_ok { $meta->add_package_symbol()    } '... exception thrown as expected';
 130     dies_ok { $meta->remove_package_symbol() } '... exception thrown as expected';
 131
 132     my @supers;
 133     lives_ok {
 134         @supers = $meta->superclasses;
 135     } '... got the superclasses okay';
 136
 137     dies_ok { $meta->superclasses([ 'UNIVERSAL' ]) } '... but could not set the superclasses okay';
 138
 139     my $meta_instance;
 140     lives_ok {
 141         $meta_instance = $meta->get_meta_instance;
 142     } '... got the meta instance okay';
 143     isa_ok($meta_instance, 'Class::MOP::Instance');
 144     is($meta_instance, $meta->get_meta_instance, '... and we know it is cached');
 145
 146     my @cpl;
 147     lives_ok {
 148         @cpl = $meta->class_precedence_list;
 149     } '... got the class precedence list okay';
 150     is_deeply(
 151     \@cpl,
 152     [ 'Bar', 'Foo'],
 153     '... we just have ourselves in the class precedence list');
 154
 155     my @attributes;
 156     lives_ok {
 157         @attributes = $meta->compute_all_applicable_attributes;
 158     } '... got the attribute list okay';
 159     is_deeply(
 160     [ sort { $a->name cmp $b->name } @attributes ],
 161     [ Foo->meta->get_attribute('bar'), $meta->get_attribute('baz') ],
 162     '... got the right list of attributes');
 163 }
 164
 165 {
 166     my $meta = Baz->meta;
 167     is($meta->name, 'Baz', '... checking the Baz metaclass');
 168
 169     ok($meta->is_mutable, '... our class is mutable');
 170     ok(!$meta->is_immutable, '... our class is not immutable');
 171
 172     lives_ok {
 173         $meta->make_immutable();
 174     } '... changed Baz to be immutable';
 175
 176     ok(!$meta->make_immutable, '... make immutable now returns nothing');
 177
 178     ok(!$meta->is_mutable, '... our class is no longer mutable');
 179     ok($meta->is_immutable, '... our class is now immutable');
 180
 181     isa_ok($meta, 'Class::MOP::Class');
 182
 183     dies_ok { $meta->add_method()    } '... exception thrown as expected';
 184     dies_ok { $meta->alias_method()  } '... exception thrown as expected';
 185     dies_ok { $meta->remove_method() } '... exception thrown as expected';
 186
 187     dies_ok { $meta->add_attribute()    } '... exception thrown as expected';
 188     dies_ok { $meta->remove_attribute() } '... exception thrown as expected';
 189
 190     dies_ok { $meta->add_package_symbol()    } '... exception thrown as expected';
 191     dies_ok { $meta->remove_package_symbol() } '... exception thrown as expected';
 192
 193     my @supers;
 194     lives_ok {
 195         @supers = $meta->superclasses;
 196     } '... got the superclasses okay';
 197
 198     dies_ok { $meta->superclasses([ 'UNIVERSAL' ]) } '... but could not set the superclasses okay';
 199
 200     my $meta_instance;
 201     lives_ok {
 202         $meta_instance = $meta->get_meta_instance;
 203     } '... got the meta instance okay';
 204     isa_ok($meta_instance, 'Class::MOP::Instance');
 205     is($meta_instance, $meta->get_meta_instance, '... and we know it is cached');
 206
 207     my @cpl;
 208     lives_ok {
 209         @cpl = $meta->class_precedence_list;
 210     } '... got the class precedence list okay';
 211     is_deeply(
 212     \@cpl,
 213     [ 'Baz', 'Bar', 'Foo'],
 214     '... we just have ourselves in the class precedence list');
 215
 216     my @attributes;
 217     lives_ok {
 218         @attributes = $meta->compute_all_applicable_attributes;
 219     } '... got the attribute list okay';
 220     is_deeply(
 221     [ sort { $a->name cmp $b->name } @attributes ],
 222     [ $meta->get_attribute('bah'), Foo->meta->get_attribute('bar'), Bar->meta->get_attribute('baz') ],
 223     '... got the right list of attributes');
 224 }
 225
 226