t/071_immutable_w_custom_metaclass.t

   1 use strict;
   2 use warnings;
   3
   4 use FindBin;
   5 use File::Spec::Functions;
   6
   7 use Test::More;
   8 use Test::Exception;
   9 use Scalar::Util;
  10
  11 use Class::MOP;
  12
  13 use lib catdir( $FindBin::Bin, 'lib' );
  14
  15 {
  16
  17     package Foo;
  18
  19     use strict;
  20     use warnings;
  21     use metaclass;
  22
  23     __PACKAGE__->meta->make_immutable;
  24
  25     package Bar;
  26
  27     use strict;
  28     use warnings;
  29     use metaclass;
  30
  31     __PACKAGE__->meta->make_immutable;
  32
  33     package Baz;
  34
  35     use strict;
  36     use warnings;
  37     use metaclass 'MyMetaClass';
  38
  39     sub mymetaclass_attributes {
  40         shift->meta->mymetaclass_attributes;
  41     }
  42
  43     ::lives_ok{ Baz->meta->superclasses('Bar') }
  44         '... we survive the metaclass incompatibility test';
  45 }
  46
  47 {
  48     my $meta = Baz->meta;
  49     ok( $meta->is_mutable, '... Baz is mutable' );
  50     is(
  51         Scalar::Util::blessed( Foo->meta ),
  52         Scalar::Util::blessed( Bar->meta ),
  53         'Foo and Bar immutable metaclasses match'
  54     );
  55     is( Scalar::Util::blessed($meta), 'MyMetaClass',
  56         'Baz->meta blessed as MyMetaClass' );
  57     ok( Baz->can('mymetaclass_attributes'),
  58         '... Baz can do method before immutable' );
  59     ok( $meta->can('mymetaclass_attributes'),
  60         '... meta can do method before immutable' );
  61     lives_ok { $meta->make_immutable } "Baz is now immutable";
  62     ok( $meta->is_immutable, '... Baz is immutable' );
  63     isa_ok( $meta, 'MyMetaClass', 'Baz->meta' );
  64     ok( Baz->can('mymetaclass_attributes'),
  65         '... Baz can do method after imutable' );
  66     ok( $meta->can('mymetaclass_attributes'),
  67         '... meta can do method after immutable' );
  68     isnt( Scalar::Util::blessed( Baz->meta ),
  69         Scalar::Util::blessed( Bar->meta ),
  70         'Baz and Bar immutable metaclasses are different' );
  71     lives_ok { $meta->make_mutable } "Baz is now mutable";
  72     ok( $meta->is_mutable, '... Baz is mutable again' );
  73 }
  74
  75 done_testing;