Commit | Line | Data |
948cd189 |
1 | use strict; |
2 | use warnings; |
3 | |
4 | use Test::More; |
5 | use Test::Moose; |
6 | |
7 | { |
8 | package Role::A; |
948cd189 |
9 | use Moose::Role |
10 | } |
11 | |
12 | { |
13 | package Role::B; |
948cd189 |
14 | use Moose::Role |
15 | } |
16 | |
17 | { |
18 | package Foo; |
948cd189 |
19 | use Moose; |
20 | } |
21 | |
22 | { |
23 | package Bar; |
948cd189 |
24 | use Moose; |
25 | |
26 | with 'Role::A'; |
27 | } |
28 | |
29 | { |
30 | package Baz; |
948cd189 |
31 | use Moose; |
32 | |
33 | with qw( Role::A Role::B ); |
34 | } |
35 | |
3eb38dc6 |
36 | { |
a19b6b35 |
37 | package Foo::Child; |
38 | use Moose; |
39 | |
40 | extends 'Foo'; |
41 | } |
42 | |
43 | { |
3eb38dc6 |
44 | package Bar::Child; |
45 | use Moose; |
46 | |
47 | extends 'Bar'; |
48 | } |
49 | |
50 | { |
51 | package Baz::Child; |
52 | use Moose; |
53 | |
54 | extends 'Baz'; |
55 | } |
56 | |
948cd189 |
57 | with_immutable { |
58 | |
a19b6b35 |
59 | for my $thing ( 'Foo', Foo->new, 'Foo::Child', Foo::Child->new ) { |
f8606f1a |
60 | my $name = ref $thing ? (ref $thing) . ' object' : "$thing class"; |
948cd189 |
61 | $name .= ' (immutable)' if $thing->meta->is_immutable; |
62 | |
63 | ok( |
64 | !$thing->does('Role::A'), |
65 | "$name does not do Role::A" |
66 | ); |
67 | ok( |
68 | !$thing->does('Role::B'), |
69 | "$name does not do Role::B" |
70 | ); |
71 | |
72 | ok( |
73 | !$thing->does( Role::A->meta ), |
74 | "$name does not do Role::A (passed as object)" |
75 | ); |
76 | ok( |
77 | !$thing->does( Role::B->meta ), |
78 | "$name does not do Role::B (passed as object)" |
79 | ); |
80 | |
81 | ok( |
82 | !$thing->DOES('Role::A'), |
83 | "$name does not do Role::A (using DOES)" |
84 | ); |
85 | ok( |
86 | !$thing->DOES('Role::B'), |
87 | "$name does not do Role::B (using DOES)" |
88 | ); |
89 | } |
90 | |
3eb38dc6 |
91 | for my $thing ( 'Bar', Bar->new, 'Bar::Child', Bar::Child->new ) { |
f8606f1a |
92 | my $name = ref $thing ? (ref $thing) . ' object' : "$thing class"; |
948cd189 |
93 | $name .= ' (immutable)' if $thing->meta->is_immutable; |
94 | |
95 | ok( |
96 | $thing->does('Role::A'), |
97 | "$name does Role::A" |
98 | ); |
99 | ok( |
100 | !$thing->does('Role::B'), |
101 | "$name does not do Role::B" |
102 | ); |
103 | |
104 | ok( |
105 | $thing->does( Role::A->meta ), |
106 | "$name does Role::A (passed as object)" |
107 | ); |
108 | ok( |
109 | !$thing->does( Role::B->meta ), |
110 | "$name does not do Role::B (passed as object)" |
111 | ); |
112 | |
113 | ok( |
114 | $thing->DOES('Role::A'), |
115 | "$name does Role::A (using DOES)" |
116 | ); |
117 | ok( |
118 | !$thing->DOES('Role::B'), |
119 | "$name does not do Role::B (using DOES)" |
120 | ); |
121 | } |
122 | |
3eb38dc6 |
123 | for my $thing ( 'Baz', Baz->new, 'Baz::Child', Baz::Child->new ) { |
f8606f1a |
124 | my $name = ref $thing ? (ref $thing) . ' object' : "$thing class"; |
948cd189 |
125 | $name .= ' (immutable)' if $thing->meta->is_immutable; |
126 | |
127 | ok( |
128 | $thing->does('Role::A'), |
129 | "$name does Role::A" |
130 | ); |
131 | ok( |
132 | $thing->does('Role::B'), |
133 | "$name does Role::B" |
134 | ); |
135 | |
136 | ok( |
137 | $thing->does( Role::A->meta ), |
138 | "$name does Role::A (passed as object)" |
139 | ); |
140 | ok( |
141 | $thing->does( Role::B->meta ), |
142 | "$name does Role::B (passed as object)" |
143 | ); |
144 | |
145 | ok( |
146 | $thing->DOES('Role::A'), |
147 | "$name does Role::A (using DOES)" |
148 | ); |
149 | ok( |
150 | $thing->DOES('Role::B'), |
151 | "$name does Role::B (using DOES)" |
152 | ); |
153 | } |
154 | |
155 | } |
5efb2dcb |
156 | qw( Foo Bar Baz Foo::Child Bar::Child Baz::Child ); |
948cd189 |
157 | |
158 | done_testing; |