t/cmop/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::Fatal;
   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     ::is( ::exception { Baz->meta->superclasses('Bar') }, undef, '... we survive the metaclass incompatibility test' );
  44 }
  45
  46 {
  47     my $meta = Baz->meta;
  48     ok( $meta->is_mutable, '... Baz is mutable' );
  49     is(
  50         Scalar::Util::blessed( Foo->meta ),
  51         Scalar::Util::blessed( Bar->meta ),
  52         'Foo and Bar immutable metaclasses match'
  53     );
  54     is( Scalar::Util::blessed($meta), 'MyMetaClass',
  55         'Baz->meta blessed as MyMetaClass' );
  56     ok( Baz->can('mymetaclass_attributes'),
  57         '... Baz can do method before immutable' );
  58     ok( $meta->can('mymetaclass_attributes'),
  59         '... meta can do method before immutable' );
  60     is( exception { $meta->make_immutable }, undef, "Baz is now immutable" );
  61     ok( $meta->is_immutable, '... Baz is immutable' );
  62     isa_ok( $meta, 'MyMetaClass', 'Baz->meta' );
  63     ok( Baz->can('mymetaclass_attributes'),
  64         '... Baz can do method after imutable' );
  65     ok( $meta->can('mymetaclass_attributes'),
  66         '... meta can do method after immutable' );
  67     isnt( Scalar::Util::blessed( Baz->meta ),
  68         Scalar::Util::blessed( Bar->meta ),
  69         'Baz and Bar immutable metaclasses are different' );
  70     is( exception { $meta->make_mutable }, undef, "Baz is now mutable" );
  71     ok( $meta->is_mutable, '... Baz is mutable again' );
  72 }
  73
  74 done_testing;