Commit | Line | Data |
23791e49 |
1 | #!perl |
2e92bb89 |
2 | use strict; |
3 | use warnings; |
23791e49 |
4 | use Test::More; |
2e92bb89 |
5 | |
23791e49 |
6 | my $foo = 0; |
7 | my $bar = 0; |
2e92bb89 |
8 | { |
9 | package FooRole; |
10 | use Mouse::Role; |
11 | sub foo { 'ok1' } |
23791e49 |
12 | |
13 | before method => sub { $foo++ }; |
2e92bb89 |
14 | } |
15 | |
16 | { |
17 | package BarRole; |
18 | use Mouse::Role; |
19 | sub bar { 'ok2' } |
23791e49 |
20 | |
21 | before method => sub { $bar++ }; |
2e92bb89 |
22 | } |
23 | |
24 | { |
25 | package Baz; |
26 | use Mouse; |
23791e49 |
27 | sub method {} |
2e92bb89 |
28 | no Mouse; |
29 | } |
30 | |
23791e49 |
31 | { |
32 | package Qux; |
33 | use Mouse; |
34 | sub method {} |
35 | no Mouse; |
36 | } |
2e92bb89 |
37 | |
23791e49 |
38 | Mouse::Util::apply_all_roles('Baz', 'BarRole', 'FooRole'); |
2e92bb89 |
39 | |
40 | my $baz = Baz->new; |
41 | is $baz->foo, 'ok1'; |
42 | is $baz->bar, 'ok2'; |
23791e49 |
43 | is join(",", sort $baz->meta->get_method_list), 'bar,foo,meta,method'; |
44 | |
45 | # applyu to instance |
46 | |
47 | my $qux = Qux->new; |
48 | Mouse::Util::apply_all_roles($qux, 'FooRole'); |
49 | note $qux; |
50 | $foo = 0; |
51 | $bar = 0; |
52 | $qux->method; |
53 | is $foo, 1; |
54 | is $bar, 0; |
55 | |
56 | $qux = Qux->new; |
57 | Mouse::Util::apply_all_roles($qux, 'BarRole'); |
58 | note $qux; |
59 | $foo = 0; |
60 | $bar = 0; |
61 | $qux->method; |
62 | is $foo, 0; |
63 | is $bar, 1; |
64 | |
65 | $qux = Qux->new; |
66 | Mouse::Util::apply_all_roles($qux, 'FooRole', 'BarRole'); |
67 | note $qux; |
68 | $foo = 0; |
69 | $bar = 0; |
70 | $qux->method; |
71 | is $foo, 1; |
72 | is $bar, 1; |
73 | |
74 | done_testing; |
2e92bb89 |
75 | |