t/bugs/immutable_metaclass_does_role.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7 use Test::Fatal;
   8
   9
  10 BEGIN {
  11     package MyRole;
  12     use Moose::Role;
  13
  14     requires 'foo';
  15
  16     package MyMetaclass;
  17     use Moose qw(extends with);
  18     extends 'Moose::Meta::Class';
  19        with 'MyRole';
  20
  21     sub foo { 'i am foo' }
  22 }
  23
  24 {
  25     package MyClass;
  26     use metaclass ('MyMetaclass');
  27     use Moose;
  28 }
  29
  30 my $mc = MyMetaclass->initialize('MyClass');
  31 isa_ok($mc, 'MyMetaclass');
  32
  33 ok($mc->meta->does_role('MyRole'), '... the metaclass does the role');
  34
  35 is(MyClass->meta, $mc, '... these metas are the same thing');
  36 is(MyClass->meta->meta, $mc->meta, '... these meta-metas are the same thing');
  37
  38 my $a = MyClass->new;
  39 ok( $a->meta->meta->does_role('MyRole'), 'metaclass does MyRole' );
  40 is( $a->meta->foo, 'i am foo', '... foo method returns expected value' );
  41 ok( MyClass->meta->meta->does_role('MyRole'), 'metaclass does MyRole' );
  42 is( MyClass->meta->foo, 'i am foo', '... foo method returns expected value' );
  43
  44 is( exception {
  45     MyClass->meta->make_immutable;
  46 }, undef, '... make MyClass immutable okay' );
  47
  48 is(MyClass->meta, $mc, '... these metas are still the same thing');
  49 is(MyClass->meta->meta, $mc->meta, '... these meta-metas are the same thing');
  50
  51 ok( $a->meta->meta->does_role('MyRole'), 'metaclass does MyRole' );
  52 is( $a->meta->foo, 'i am foo', '... foo method returns expected value' );
  53 ok( MyClass->meta->meta->does_role('MyRole'), 'metaclass does MyRole' );
  54 is( MyClass->meta->foo, 'i am foo', '... foo method returns expected value' );
  55
  56 is( exception {
  57     MyClass->meta->make_mutable;
  58 }, undef, '... make MyClass mutable okay' );
  59
  60 is(MyClass->meta, $mc, '... these metas are still the same thing');
  61 is(MyClass->meta->meta, $mc->meta, '... these meta-metas are the same thing');
  62
  63 ok( $a->meta->meta->does_role('MyRole'), 'metaclass does MyRole' );
  64 is( $a->meta->foo, 'i am foo', '... foo method returns expected value' );
  65 ok( MyClass->meta->meta->does_role('MyRole'), 'metaclass does MyRole' );
  66 is( MyClass->meta->foo, 'i am foo', '... foo method returns expected value' );
  67
  68 is( exception {
  69     MyMetaclass->meta->make_immutable;
  70 }, undef, '... make MyMetaclass immutable okay' );
  71
  72 is(MyClass->meta, $mc, '... these metas are still the same thing');
  73 is(MyClass->meta->meta, $mc->meta, '... these meta-metas are the same thing');
  74
  75 ok( $a->meta->meta->does_role('MyRole'), 'metaclass does MyRole' );
  76 is( $a->meta->foo, 'i am foo', '... foo method returns expected value' );
  77 ok( MyClass->meta->meta->does_role('MyRole'), 'metaclass does MyRole' );
  78 is( MyClass->meta->foo, 'i am foo', '... foo method returns expected value' );
  79
  80 is( exception {
  81     MyClass->meta->make_immutable;
  82 }, undef, '... make MyClass immutable (again) okay' );
  83
  84 is(MyClass->meta, $mc, '... these metas are still the same thing');
  85 is(MyClass->meta->meta, $mc->meta, '... these meta-metas are the same thing');
  86
  87 ok( $a->meta->meta->does_role('MyRole'), 'metaclass does MyRole' );
  88 is( $a->meta->foo, 'i am foo', '... foo method returns expected value' );
  89 ok( MyClass->meta->meta->does_role('MyRole'), 'metaclass does MyRole' );
  90 is( MyClass->meta->foo, 'i am foo', '... foo method returns expected value' );
  91
  92 done_testing;