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