t/001_mouse/067-traits.t

   1 #!perl
   2 use strict;
   3 use warnings;
   4
   5 use Test::More;
   6
   7 use Test::Mouse qw(does_ok);
   8
   9 BEGIN{ $SIG{__WARN__} = \&Carp::confess }
  10
  11 BEGIN {
  12     package MyMouseX::Foo::Method;
  13     use Mouse::Role;
  14
  15     sub foo_method {}
  16
  17     package MyMouseX::Foo::Class;
  18     use Mouse::Role;
  19
  20     sub foo_class {}
  21
  22     package MyMouseX::Bar::Method;
  23     use Mouse::Role;
  24
  25     sub bar {}
  26
  27     package MyMouseX::Bar::Class;
  28     use Mouse::Role;
  29
  30     sub bar_class {}
  31 }
  32
  33 BEGIN {
  34     package MyMouseX::Foo;
  35     use Mouse::Exporter;
  36     use Mouse::Util::MetaRole;
  37
  38     Mouse::Exporter->setup_import_methods(
  39         also => 'Mouse',
  40     );
  41     sub init_meta {
  42         my(undef, %options) = @_;
  43
  44         my $meta = Mouse->init_meta(%options);
  45         Mouse::Util::MetaRole::apply_metaroles(
  46             for             => $options{for_class},
  47             class_metaroles => {
  48                 class  => ['MyMouseX::Foo::Class'],
  49                 method => ['MyMouseX::Foo::Method'],
  50             },
  51         );
  52     }
  53
  54     $INC{'MyMouseX/Foo.pm'} = __FILE__;
  55
  56     package MyMouseX::Bar;
  57     use Mouse::Exporter;
  58     use Mouse::Util::MetaRole;
  59
  60     Mouse::Exporter->setup_import_methods(
  61         also => 'Mouse',
  62     );
  63     sub init_meta {
  64         my(undef, %options) = @_;
  65
  66         my $meta = Mouse->init_meta(%options);
  67         Mouse::Util::MetaRole::apply_metaroles(
  68             for             => $options{for_class},
  69             class_metaroles => {
  70                 class  => ['MyMouseX::Bar::Class'],
  71                 method => ['MyMouseX::Bar::Method'],
  72             },
  73         );
  74     }
  75
  76     $INC{'MyMouseX/Bar.pm'} = __FILE__;
  77 }
  78 {
  79     package ClassA;
  80     use MyMouseX::Foo;
  81
  82     sub a {}
  83
  84     package ClassB;
  85     use MyMouseX::Bar;
  86
  87     sub b {}
  88
  89     package ClassXAFoo;
  90     use MyMouseX::Foo;
  91
  92     extends qw(ClassA);
  93
  94     sub xa {}
  95
  96     package ClassXABar;
  97     use MyMouseX::Bar;
  98
  99     extends qw(ClassA);
 100
 101     sub xa {}
 102 }
 103
 104 does_ok(ClassA->meta,                  'MyMouseX::Foo::Class');
 105 does_ok(ClassA->meta->get_method('a'), 'MyMouseX::Foo::Method');
 106
 107 does_ok(ClassB->meta,                  'MyMouseX::Bar::Class');
 108 does_ok(ClassB->meta->get_method('b'), 'MyMouseX::Bar::Method');
 109
 110
 111 does_ok(ClassXAFoo->meta,                   'MyMouseX::Foo::Class');
 112 does_ok(ClassXAFoo->meta->get_method('xa'), 'MyMouseX::Foo::Method');
 113
 114 does_ok(ClassXABar->meta,                   'MyMouseX::Foo::Class');
 115 does_ok(ClassXABar->meta->get_method('xa'), 'MyMouseX::Foo::Method');
 116
 117 does_ok(ClassXABar->meta,                   'MyMouseX::Bar::Class');
 118 does_ok(ClassXABar->meta->get_method('xa'), 'MyMouseX::Bar::Method');
 119
 120
 121 done_testing;