t/030_roles/033_role_exclusion_and_alias_bug.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 17;
   7 use lib 't/lib';
   8 use Test::Mouse;
   9
  10 {
  11     package My::Role;
  12     use Mouse::Role;
  13
  14     sub foo { "FOO" }
  15     sub bar { "BAR" }
  16 }
  17
  18 {
  19     package My::Class;
  20     use Mouse;
  21
  22     with 'My::Role' => {
  23         -alias    => { foo => 'baz', bar => 'gorch' },
  24         -excludes => ['foo', 'bar'],
  25     };
  26 }
  27
  28 {
  29     my $x = My::Class->new;
  30     isa_ok($x, 'My::Class');
  31     does_ok($x, 'My::Role');
  32
  33     can_ok($x, $_) for qw[baz gorch];
  34
  35     ok(!$x->can($_), '... cant call method ' . $_) for qw[foo bar];
  36
  37     is($x->baz, 'FOO', '... got the right value');
  38     is($x->gorch, 'BAR', '... got the right value');
  39 }
  40
  41 {
  42     package My::Role::Again;
  43     use Mouse::Role;
  44
  45     with 'My::Role' => {
  46         -alias    => { foo => 'baz', bar => 'gorch' },
  47         -excludes => ['foo', 'bar'],
  48     };
  49
  50     package My::Class::Again;
  51     use Mouse;
  52
  53     with 'My::Role::Again';
  54 }
  55
  56 {
  57     my $x = My::Class::Again->new;
  58     isa_ok($x, 'My::Class::Again');
  59     does_ok($x, 'My::Role::Again');
  60     does_ok($x, 'My::Role');
  61
  62     can_ok($x, $_) for qw[baz gorch];
  63
  64     ok(!$x->can($_), '... cant call method ' . $_) for qw[foo bar];
  65
  66     is($x->baz, 'FOO', '... got the right value');
  67     is($x->gorch, 'BAR', '... got the right value');
  68 }
  69
  70