1use strict;
2use warnings;
3
4use Test::More;
5use Test::Moose;
6
7{
8    package Role::A;
9    use Moose::Role
10}
11
12{
13    package Role::B;
14    use Moose::Role
15}
16
17{
18    package Foo;
19    use Moose;
20}
21
22{
23    package Bar;
24    use Moose;
25
26    with 'Role::A';
27}
28
29{
30    package Baz;
31    use Moose;
32
33    with qw( Role::A Role::B );
34}
35
36{
37    package Foo::Child;
38    use Moose;
39
40    extends 'Foo';
41}
42
43{
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
57with_immutable {
58
59    for my $thing ( 'Foo', Foo->new, 'Foo::Child', Foo::Child->new ) {
60        my $name = ref $thing ? (ref $thing) . ' object' : "$thing class";
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
91    for my $thing ( 'Bar', Bar->new, 'Bar::Child', Bar::Child->new ) {
92        my $name = ref $thing ? (ref $thing) . ' object' : "$thing class";
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
123    for my $thing ( 'Baz', Baz->new, 'Baz::Child', Baz::Child->new ) {
124        my $name = ref $thing ? (ref $thing) . ' object' : "$thing class";
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}
156qw( Foo Bar Baz Foo::Child Bar::Child Baz::Child );
157
158done_testing;
159