t/070_immutable_metaclass.t

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