t/070_immutable_metaclass.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 77;
   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->add_method()    } '... exception thrown as expected';
  64     dies_ok { $meta->alias_method()  } '... exception thrown as expected';
  65     dies_ok { $meta->remove_method() } '... exception thrown as expected';
  66
  67     dies_ok { $meta->add_attribute()    } '... exception thrown as expected';
  68     dies_ok { $meta->remove_attribute() } '... exception thrown as expected';
  69
  70     dies_ok { $meta->add_package_symbol()    } '... exception thrown as expected';
  71     dies_ok { $meta->remove_package_symbol() } '... exception thrown as expected';
  72
  73     my @supers;
  74     lives_ok {
  75         @supers = $meta->superclasses;
  76     } '... got the superclasses okay';
  77
  78     dies_ok { $meta->superclasses([ 'UNIVERSAL' ]) } '... but could not set the superclasses okay';
  79
  80     my $meta_instance;
  81     lives_ok {
  82         $meta_instance = $meta->get_meta_instance;
  83     } '... got the meta instance okay';
  84     isa_ok($meta_instance, 'Class::MOP::Instance');
  85     is($meta_instance, $meta->get_meta_instance, '... and we know it is cached');
  86
  87     my @cpl;
  88     lives_ok {
  89         @cpl = $meta->class_precedence_list;
  90     } '... got the class precedence list okay';
  91     is_deeply(
  92     \@cpl,
  93     [ 'Foo' ],
  94     '... we just have ourselves in the class precedence list');
  95
  96     my @attributes;
  97     lives_ok {
  98         @attributes = $meta->compute_all_applicable_attributes;
  99     } '... got the attribute list okay';
 100     is_deeply(
 101     \@attributes,
 102     [ $meta->get_attribute('bar') ],
 103     '... got the right list of attributes');
 104 }
 105
 106 {
 107     my $meta = Bar->meta;
 108     is($meta->name, 'Bar', '... checking the Bar metaclass');
 109
 110     ok($meta->is_mutable, '... our class is mutable');
 111     ok(!$meta->is_immutable, '... our class is not immutable');
 112
 113     lives_ok {
 114         $meta->make_immutable();
 115     } '... changed Bar to be immutable';
 116
 117     ok(!$meta->make_immutable, '... make immutable now returns nothing');
 118
 119     ok(!$meta->is_mutable, '... our class is no longer mutable');
 120     ok($meta->is_immutable, '... our class is now immutable');
 121
 122     isa_ok($meta, 'Class::MOP::Class::Immutable');
 123     isa_ok($meta, 'Class::MOP::Class');
 124
 125     dies_ok { $meta->add_method()    } '... exception thrown as expected';
 126     dies_ok { $meta->alias_method()  } '... exception thrown as expected';
 127     dies_ok { $meta->remove_method() } '... exception thrown as expected';
 128
 129     dies_ok { $meta->add_attribute()    } '... exception thrown as expected';
 130     dies_ok { $meta->remove_attribute() } '... exception thrown as expected';
 131
 132     dies_ok { $meta->add_package_symbol()    } '... exception thrown as expected';
 133     dies_ok { $meta->remove_package_symbol() } '... exception thrown as expected';
 134
 135     my @supers;
 136     lives_ok {
 137         @supers = $meta->superclasses;
 138     } '... got the superclasses okay';
 139
 140     dies_ok { $meta->superclasses([ 'UNIVERSAL' ]) } '... but could not set the superclasses okay';
 141
 142     my $meta_instance;
 143     lives_ok {
 144         $meta_instance = $meta->get_meta_instance;
 145     } '... got the meta instance okay';
 146     isa_ok($meta_instance, 'Class::MOP::Instance');
 147     is($meta_instance, $meta->get_meta_instance, '... and we know it is cached');
 148
 149     my @cpl;
 150     lives_ok {
 151         @cpl = $meta->class_precedence_list;
 152     } '... got the class precedence list okay';
 153     is_deeply(
 154     \@cpl,
 155     [ 'Bar', 'Foo'],
 156     '... we just have ourselves in the class precedence list');
 157
 158     my @attributes;
 159     lives_ok {
 160         @attributes = $meta->compute_all_applicable_attributes;
 161     } '... got the attribute list okay';
 162     is_deeply(
 163     [ sort { $a->name cmp $b->name } @attributes ],
 164     [ Foo->meta->get_attribute('bar'), $meta->get_attribute('baz') ],
 165     '... got the right list of attributes');
 166 }
 167
 168 {
 169     my $meta = Baz->meta;
 170     is($meta->name, 'Baz', '... checking the Baz metaclass');
 171
 172     ok($meta->is_mutable, '... our class is mutable');
 173     ok(!$meta->is_immutable, '... our class is not immutable');
 174
 175     lives_ok {
 176         $meta->make_immutable();
 177     } '... changed Baz to be immutable';
 178
 179     ok(!$meta->make_immutable, '... make immutable now returns nothing');
 180
 181     ok(!$meta->is_mutable, '... our class is no longer mutable');
 182     ok($meta->is_immutable, '... our class is now immutable');
 183
 184     isa_ok($meta, 'Class::MOP::Class::Immutable');
 185     isa_ok($meta, 'Class::MOP::Class');
 186
 187     dies_ok { $meta->add_method()    } '... exception thrown as expected';
 188     dies_ok { $meta->alias_method()  } '... exception thrown as expected';
 189     dies_ok { $meta->remove_method() } '... exception thrown as expected';
 190
 191     dies_ok { $meta->add_attribute()    } '... exception thrown as expected';
 192     dies_ok { $meta->remove_attribute() } '... exception thrown as expected';
 193
 194     dies_ok { $meta->add_package_symbol()    } '... exception thrown as expected';
 195     dies_ok { $meta->remove_package_symbol() } '... exception thrown as expected';
 196
 197     my @supers;
 198     lives_ok {
 199         @supers = $meta->superclasses;
 200     } '... got the superclasses okay';
 201
 202     dies_ok { $meta->superclasses([ 'UNIVERSAL' ]) } '... but could not set the superclasses okay';
 203
 204     my $meta_instance;
 205     lives_ok {
 206         $meta_instance = $meta->get_meta_instance;
 207     } '... got the meta instance okay';
 208     isa_ok($meta_instance, 'Class::MOP::Instance');
 209     is($meta_instance, $meta->get_meta_instance, '... and we know it is cached');
 210
 211     my @cpl;
 212     lives_ok {
 213         @cpl = $meta->class_precedence_list;
 214     } '... got the class precedence list okay';
 215     is_deeply(
 216     \@cpl,
 217     [ 'Baz', 'Bar', 'Foo'],
 218     '... we just have ourselves in the class precedence list');
 219
 220     my @attributes;
 221     lives_ok {
 222         @attributes = $meta->compute_all_applicable_attributes;
 223     } '... got the attribute list okay';
 224     is_deeply(
 225     [ sort { $a->name cmp $b->name } @attributes ],
 226     [ $meta->get_attribute('bah'), Foo->meta->get_attribute('bar'), Bar->meta->get_attribute('baz') ],
 227     '... got the right list of attributes');
 228 }
 229
 230