t/070_immutable_metaclass.t

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