Commit | Line | Data |
0f24a39d |
1 | package SharedTests; |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6 | use Scalar::Util qw( isweak ); |
54a288bd |
7 | use Test::More; |
8 | |
9 | my $HasMXAH; |
10 | BEGIN |
11 | { |
7a8e32bc |
12 | if ( eval 'use MooseX::AttributeHelpers 0.13; 1;' ) |
54a288bd |
13 | { |
14 | $HasMXAH = 1; |
15 | } |
16 | } |
17 | |
7a4a3b1e |
18 | sub HasMXAH { $HasMXAH } |
0f24a39d |
19 | |
20 | { |
21 | package HasClassAttribute; |
22 | |
5091e7b5 |
23 | use Moose qw( has ); |
0f24a39d |
24 | use MooseX::ClassAttribute; |
25 | |
54a288bd |
26 | use vars qw($Lazy); |
27 | $Lazy = 0; |
28 | |
29 | class_has 'ObjectCount' => |
30 | ( is => 'rw', |
0f24a39d |
31 | isa => 'Int', |
32 | default => 0, |
33 | ); |
34 | |
54a288bd |
35 | class_has 'WeakAttribute' => |
36 | ( is => 'rw', |
0f24a39d |
37 | isa => 'Object', |
38 | weak_ref => 1, |
39 | ); |
40 | |
54a288bd |
41 | class_has 'LazyAttribute' => |
42 | ( is => 'rw', |
43 | isa => 'Int', |
44 | lazy => 1, |
45 | # The side effect is used to test that this was called |
46 | # lazily. |
47 | default => sub { $Lazy = 1 }, |
48 | ); |
49 | |
50 | class_has 'ReadOnlyAttribute' => |
51 | ( is => 'ro', |
52 | isa => 'Int', |
53 | default => 10, |
54 | ); |
55 | |
56 | class_has 'ManyNames' => |
57 | ( is => 'rw', |
58 | isa => 'Int', |
59 | reader => 'M', |
60 | writer => 'SetM', |
61 | clearer => 'ClearM', |
62 | predicate => 'HasM', |
63 | ); |
64 | |
65 | class_has 'Delegatee' => |
66 | ( is => 'rw', |
67 | isa => 'Delegatee', |
68 | handles => [ 'units', 'color' ], |
7a8e32bc |
69 | # if it's not lazy it makes a new object before we define |
70 | # Delegatee's attributes. |
71 | lazy => 1, |
54a288bd |
72 | default => sub { Delegatee->new() }, |
73 | ); |
74 | |
7a4a3b1e |
75 | if ( SharedTests->HasMXAH() ) |
54a288bd |
76 | { |
77 | class_has 'Mapping' => |
78 | ( metaclass => 'Collection::Hash', |
79 | is => 'rw', |
80 | isa => 'HashRef[Str]', |
81 | default => sub { {} }, |
82 | provides => |
83 | { exists => 'ExistsInMapping', |
84 | keys => 'IdsInMapping', |
85 | get => 'GetMapping', |
86 | set => 'SetMapping', |
87 | }, |
88 | ); |
89 | } |
90 | |
0f24a39d |
91 | has 'size' => |
92 | ( is => 'rw', |
93 | isa => 'Int', |
94 | default => 5, |
95 | ); |
96 | |
54a288bd |
97 | no Moose; |
54a288bd |
98 | |
0f24a39d |
99 | sub BUILD |
100 | { |
6b059c78 |
101 | my $self = shift; |
0f24a39d |
102 | |
6b059c78 |
103 | $self->ObjectCount( $self->ObjectCount() + 1 ); |
0f24a39d |
104 | } |
54a288bd |
105 | |
106 | sub make_immutable |
107 | { |
108 | my $class = shift; |
109 | |
110 | $class->meta()->make_immutable(); |
54a288bd |
111 | Delegatee->meta()->make_immutable(); |
112 | } |
113 | } |
114 | |
115 | { |
116 | package Delegatee; |
117 | |
118 | use Moose; |
119 | |
120 | has 'units' => |
121 | ( is => 'ro', |
122 | default => 5, |
123 | ); |
124 | |
125 | has 'color' => |
126 | ( is => 'ro', |
127 | default => 'blue', |
128 | ); |
7a8e32bc |
129 | |
130 | no Moose; |
54a288bd |
131 | } |
132 | |
133 | { |
134 | package Child; |
135 | |
136 | use Moose; |
137 | use MooseX::ClassAttribute; |
138 | |
139 | extends 'HasClassAttribute'; |
140 | |
141 | class_has '+ReadOnlyAttribute' => |
142 | ( default => 30 ); |
7a8e32bc |
143 | |
7a4a3b1e |
144 | class_has 'YetAnotherAttribute' => |
145 | ( is => 'ro', |
146 | default => 'thing', |
147 | ); |
148 | |
7a8e32bc |
149 | no Moose; |
0f24a39d |
150 | } |
151 | |
152 | sub run_tests |
153 | { |
7a8e32bc |
154 | plan tests => 24; |
155 | |
0f24a39d |
156 | local $Test::Builder::Level = $Test::Builder::Level + 1; |
157 | |
158 | { |
159 | is( HasClassAttribute->ObjectCount(), 0, |
160 | 'ObjectCount() is 0' ); |
161 | |
162 | my $hca1 = HasClassAttribute->new(); |
163 | is( $hca1->size(), 5, |
164 | 'size is 5 - object attribute works as expected' ); |
165 | is( HasClassAttribute->ObjectCount(), 1, |
166 | 'ObjectCount() is 1' ); |
167 | |
168 | my $hca2 = HasClassAttribute->new( size => 10 ); |
169 | is( $hca2->size(), 10, |
170 | 'size is 10 - object attribute can be set via constructor' ); |
171 | is( HasClassAttribute->ObjectCount(), 2, |
172 | 'ObjectCount() is 2' ); |
173 | is( $hca2->ObjectCount(), 2, |
174 | 'ObjectCount() is 2 - can call class attribute accessor on object' ); |
175 | } |
176 | |
177 | { |
54a288bd |
178 | my $hca3 = HasClassAttribute->new( ObjectCount => 20 ); |
179 | is( $hca3->ObjectCount(), 3, |
180 | 'class attributes passed to the constructor do not get set in the object' ); |
181 | is( HasClassAttribute->ObjectCount(), 3, |
0f24a39d |
182 | 'class attributes are not affected by constructor params' ); |
183 | } |
184 | |
185 | { |
186 | my $object = bless {}, 'Thing'; |
187 | |
188 | HasClassAttribute->WeakAttribute($object); |
189 | |
6b059c78 |
190 | undef $object; |
191 | |
192 | ok( ! defined HasClassAttribute->WeakAttribute(), |
0f24a39d |
193 | 'weak class attributes are weak' ); |
194 | } |
54a288bd |
195 | |
196 | { |
197 | is( $HasClassAttribute::Lazy, 0, |
198 | '$HasClassAttribute::Lazy is 0' ); |
199 | |
200 | is( HasClassAttribute->LazyAttribute(), 1, |
201 | 'HasClassAttribute->LazyAttribute() is 1' ); |
202 | |
203 | is( $HasClassAttribute::Lazy, 1, |
204 | '$HasClassAttribute::Lazy is 1 after calling LazyAttribute' ); |
205 | } |
206 | |
207 | { |
208 | eval { HasClassAttribute->ReadOnlyAttribute(20) }; |
209 | like( $@, qr/\QCannot assign a value to a read-only accessor/, |
210 | 'cannot set read-only class attribute' ); |
211 | } |
212 | |
213 | { |
214 | is( Child->ReadOnlyAttribute(), 30, |
215 | q{Child class can extend parent's class attribute} ); |
216 | } |
217 | |
218 | { |
219 | ok( ! HasClassAttribute->HasM(), |
220 | 'HasM() returns false before M is set' ); |
221 | |
222 | HasClassAttribute->SetM(22); |
223 | |
224 | ok( HasClassAttribute->HasM(), |
225 | 'HasM() returns true after M is set' ); |
226 | is( HasClassAttribute->M(), 22, |
227 | 'M() returns 22' ); |
228 | |
229 | HasClassAttribute->ClearM(); |
230 | |
231 | ok( ! HasClassAttribute->HasM(), |
232 | 'HasM() returns false after M is cleared' ); |
233 | } |
234 | |
235 | { |
236 | isa_ok( HasClassAttribute->Delegatee(), 'Delegatee', |
237 | 'has a Delegetee object' ); |
238 | is( HasClassAttribute->units(), 5, |
239 | 'units() delegates to Delegatee and returns 5' ); |
240 | } |
241 | |
54a288bd |
242 | SKIP: |
243 | { |
244 | skip 'These tests require MooseX::AttributeHelpers', 4 |
7a4a3b1e |
245 | unless SharedTests->HasMXAH(); |
54a288bd |
246 | |
247 | my @ids = HasClassAttribute->IdsInMapping(); |
248 | is( scalar @ids, 0, |
249 | 'there are no keys in the mapping yet' ); |
250 | |
251 | ok( ! HasClassAttribute->ExistsInMapping('a'), |
252 | 'key does not exist in mapping' ); |
253 | |
254 | HasClassAttribute->SetMapping( a => 20 ); |
255 | |
256 | ok( HasClassAttribute->ExistsInMapping('a'), |
257 | 'key does exist in mapping' ); |
258 | |
259 | is( HasClassAttribute->GetMapping('a'), 20, |
260 | 'value for a in mapping is 20' ); |
261 | } |
0f24a39d |
262 | } |
263 | |
264 | |
265 | 1; |