t/metaclasses/metaroles_of_metaroles.t

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use Test::More;
   5 use Test::Fatal;
   6
   7 {
   8     package ApplicationMetaRole;
   9     use Moose::Role;
  10     use Moose::Util::MetaRole;
  11
  12     after apply => sub {
  13         my ($self, $role_source, $role_dest, $args) = @_;
  14         Moose::Util::MetaRole::apply_metaroles
  15         (
  16             for            => $role_dest,
  17             role_metaroles =>
  18             {
  19                 application_to_role => ['ApplicationMetaRole'],
  20             }
  21         );
  22     };
  23 }
  24 {
  25     package MyMetaRole;
  26     use Moose::Role;
  27     use Moose::Util::MetaRole;
  28     use Moose::Exporter;
  29
  30     Moose::Exporter->setup_import_methods(also => q<Moose::Role>);
  31
  32     sub init_meta {
  33         my ($class, %opts) = @_;
  34         Moose::Role->init_meta(%opts);
  35         Moose::Util::MetaRole::apply_metaroles
  36         (
  37             for            => $opts{for_class},
  38             role_metaroles =>
  39             {
  40                 application_to_role => ['ApplicationMetaRole'],
  41             }
  42         );
  43         return $opts{for_class}->meta();
  44     };
  45 }
  46
  47 {
  48     package MyRole;
  49     use Moose::Role;
  50
  51     MyMetaRole->import;
  52
  53     use Moose::Util::TypeConstraints;
  54
  55     has schema => (
  56         is     => 'ro',
  57         coerce => 1,
  58     );
  59 }
  60
  61 {
  62     package MyTargetRole;
  63     use Moose::Role;
  64     ::is(::exception { with "MyRole" }, undef,
  65          "apply a meta role to a role, which is then applied to yet another role");
  66 }
  67
  68 done_testing;