t/030_roles/014_more_alias_and_exclude.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7 use Test::Exception;
   8
   9
  10 {
  11     package Foo;
  12     use Mouse::Role;
  13
  14     sub foo   { 'Foo::foo'   }
  15     sub bar   { 'Foo::bar'   }
  16     sub baz   { 'Foo::baz'   }
  17     sub gorch { 'Foo::gorch' }
  18
  19     package Bar;
  20     use Mouse::Role;
  21
  22     sub foo   { 'Bar::foo'   }
  23     sub bar   { 'Bar::bar'   }
  24     sub baz   { 'Bar::baz'   }
  25     sub gorch { 'Bar::gorch' }
  26
  27     package Baz;
  28     use Mouse::Role;
  29
  30     sub foo   { 'Baz::foo'   }
  31     sub bar   { 'Baz::bar'   }
  32     sub baz   { 'Baz::baz'   }
  33     sub gorch { 'Baz::gorch' }
  34
  35     package Gorch;
  36     use Mouse::Role;
  37
  38     sub foo   { 'Gorch::foo'   }
  39     sub bar   { 'Gorch::bar'   }
  40     sub baz   { 'Gorch::baz'   }
  41     sub gorch { 'Gorch::gorch' }
  42 }
  43
  44 {
  45     package My::Class;
  46     use Mouse;
  47
  48     ::lives_ok {
  49         with 'Foo'   => { -excludes => [qw/bar baz gorch/], -alias => { gorch => 'foo_gorch' } },
  50              'Bar'   => { -excludes => [qw/foo baz gorch/] },
  51              'Baz'   => { -excludes => [qw/foo bar gorch/], -alias => { foo => 'baz_foo', bar => 'baz_bar' } },
  52              'Gorch' => { -excludes => [qw/foo bar baz/] };
  53     } '... everything works out all right';
  54 }
  55
  56 my $c = My::Class->new;
  57 isa_ok($c, 'My::Class');
  58
  59 is($c->foo, 'Foo::foo', '... got the right method');
  60 is($c->bar, 'Bar::bar', '... got the right method');
  61 is($c->baz, 'Baz::baz', '... got the right method');
  62 is($c->gorch, 'Gorch::gorch', '... got the right method');
  63
  64 is($c->foo_gorch, 'Foo::gorch', '... got the right method');
  65 is($c->baz_foo, 'Baz::foo', '... got the right method');
  66 is($c->baz_bar, 'Baz::bar', '... got the right method');
  67
  68 done_testing;