one more
[gitmo/Moose.git] / t / basics / moose_object_does.t
1 use strict;
2 use warnings;
3
4 use Test::More;
5 use 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
57 with_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 }
156 qw( Foo Bar Baz Foo::Child Bar::Child Baz::Child );
157
158 done_testing;