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