Fix role application to instances;
[gitmo/Mouse.git] / t / 001_mouse / 034-apply_all_roles.t
CommitLineData
23791e49 1#!perl
2e92bb89 2use strict;
3use warnings;
23791e49 4use Test::More;
2e92bb89 5
23791e49 6my $foo = 0;
7my $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 38Mouse::Util::apply_all_roles('Baz', 'BarRole', 'FooRole');
2e92bb89 39
40my $baz = Baz->new;
41is $baz->foo, 'ok1';
42is $baz->bar, 'ok2';
23791e49 43is join(",", sort $baz->meta->get_method_list), 'bar,foo,meta,method';
44
45# applyu to instance
46
47my $qux = Qux->new;
48Mouse::Util::apply_all_roles($qux, 'FooRole');
49note $qux;
50$foo = 0;
51$bar = 0;
52$qux->method;
53is $foo, 1;
54is $bar, 0;
55
56$qux = Qux->new;
57Mouse::Util::apply_all_roles($qux, 'BarRole');
58note $qux;
59$foo = 0;
60$bar = 0;
61$qux->method;
62is $foo, 0;
63is $bar, 1;
64
65$qux = Qux->new;
66Mouse::Util::apply_all_roles($qux, 'FooRole', 'BarRole');
67note $qux;
68$foo = 0;
69$bar = 0;
70$qux->method;
71is $foo, 1;
72is $bar, 1;
73
74done_testing;
2e92bb89 75