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