Commit | Line | Data |
ddd87d75 |
1 | package MooseClass::Tests; |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
5cab7e05 |
6 | use Lingua::EN::Inflect qw( A PL_N ); |
ddd87d75 |
7 | use Test::More 'no_plan'; |
8 | |
9 | sub tests01 { |
ddd87d75 |
10 | has_meta('Person'); |
11 | |
12 | check_isa( 'Person', ['Moose::Object'] ); |
13 | |
ddd87d75 |
14 | has_rw_attr( 'Person', $_ ) for qw( first_name last_name ); |
15 | |
16 | has_method( 'Person', 'full_name' ); |
17 | |
ddd87d75 |
18 | person01(); |
19 | |
20 | has_meta('Employee'); |
21 | |
22 | check_isa( 'Employee', [ 'Person', 'Moose::Object' ] ); |
23 | |
8d1ce1d7 |
24 | has_rw_attr( 'Employee', $_ ) for qw( title salary ); |
ddd87d75 |
25 | has_ro_attr( 'Employee', 'ssn' ); |
26 | |
27 | has_overridden_method( 'Employee', 'full_name' ); |
28 | |
29 | employee01(); |
b071f963 |
30 | |
31 | no_droppings('Person'); |
32 | is_immutable('Person'); |
ddd87d75 |
33 | } |
34 | |
5cab7e05 |
35 | sub tests02 { |
70eec86e |
36 | has_meta('Printable'); |
37 | requires_method( 'Printable', 'as_string' ); |
38 | |
39 | has_meta('Person'); |
40 | does_role( 'Person', 'Printable' ); |
41 | has_method( 'Person', 'as_string' ); |
5cab7e05 |
42 | |
70eec86e |
43 | has_meta('HasAccount'); |
44 | has_method( 'HasAccount', $_ ) for qw( deposit withdraw ); |
45 | has_role_attr( 'HasAccount', 'balance' ); |
46 | |
47 | does_role( 'Person', 'HasAccount' ); |
48 | has_method( 'Person', $_ ) for qw( deposit withdraw ); |
5cab7e05 |
49 | has_rw_attr( 'Person', 'balance' ); |
50 | |
70eec86e |
51 | has_meta('Employee'); |
5cab7e05 |
52 | does_role( 'Employee', $_ ) for qw( Printable HasAccount ); |
53 | |
54 | person02(); |
55 | employee02(); |
70eec86e |
56 | |
57 | no_droppings($_) for qw( Printable HasAccount ); |
58 | |
59 | tests01(); |
5cab7e05 |
60 | } |
61 | |
8d1ce1d7 |
62 | sub tests03 { |
00c47fc4 |
63 | has_meta('Person'); |
64 | has_meta('Employee'); |
8d1ce1d7 |
65 | |
00c47fc4 |
66 | has_rw_attr( 'Person', 'title' ); |
8d1ce1d7 |
67 | |
00c47fc4 |
68 | has_rw_attr( 'Employee', 'title', 'overridden' ); |
69 | has_rw_attr( 'Employee', 'salary_level' ); |
70 | has_ro_attr( 'Employee', 'salary' ); |
8d1ce1d7 |
71 | |
00c47fc4 |
72 | has_method( 'Employee', '_build_salary' ); |
8d1ce1d7 |
73 | |
70eec86e |
74 | ok( |
75 | !Employee->meta->has_method('full_name'), |
76 | 'Employee no longer implements a full_name method' |
77 | ); |
8d1ce1d7 |
78 | |
79 | my $person_title_attr = Person->meta->get_attribute('title'); |
80 | ok( !$person_title_attr->is_required, 'title is not required in Person' ); |
70eec86e |
81 | is( |
82 | $person_title_attr->predicate, 'has_title', |
83 | 'Person title attr has a has_title predicate' |
84 | ); |
85 | is( |
86 | $person_title_attr->clearer, 'clear_title', |
87 | 'Person title attr has a clear_title clearer' |
88 | ); |
8d1ce1d7 |
89 | |
90 | my $balance_attr = Person->meta->get_attribute('balance'); |
91 | is( $balance_attr->default, 100, 'balance defaults to 100' ); |
92 | |
93 | my $employee_title_attr = Employee->meta->get_attribute('title'); |
70eec86e |
94 | is( |
95 | $employee_title_attr->default, 'Worker', |
96 | 'title defaults to Worker in Employee' |
97 | ); |
8d1ce1d7 |
98 | |
99 | my $salary_level_attr = Employee->meta->get_attribute('salary_level'); |
100 | is( $salary_level_attr->default, 1, 'salary_level defaults to 1' ); |
101 | |
102 | my $salary_attr = Employee->meta->get_attribute('salary'); |
103 | ok( !$salary_attr->init_arg, 'no init_arg for salary attribute' ); |
104 | ok( $salary_attr->has_builder, 'salary attr has a builder' ); |
105 | |
106 | person03(); |
107 | employee03(); |
108 | } |
109 | |
26164c8d |
110 | sub tests04 { |
00c47fc4 |
111 | has_meta('Document'); |
112 | has_meta('Report'); |
113 | has_meta('TPSReport'); |
26164c8d |
114 | |
00c47fc4 |
115 | no_droppings('Document'); |
116 | no_droppings('Report'); |
117 | no_droppings('TPSReport'); |
538499df |
118 | |
00c47fc4 |
119 | has_ro_attr( 'Document', $_ ) for qw( title author ); |
120 | has_ro_attr( 'Report', 'summary' ); |
121 | has_ro_attr( 'TPSReport', $_ ) for qw( t p s ); |
538499df |
122 | |
00c47fc4 |
123 | has_method( 'Document', 'output' ); |
124 | has_augmented_method( 'Report', 'output' ); |
125 | has_augmented_method( 'TPSReport', 'output' ); |
26164c8d |
126 | |
538499df |
127 | my $tps = TPSReport->new( |
128 | title => 'That TPS Report', |
129 | author => 'Peter Gibbons (for Bill Lumberg)', |
130 | summary => 'I celebrate his whole collection!', |
131 | t => 'PC Load Letter', |
132 | p => 'Swingline', |
133 | s => 'flair!', |
134 | ); |
26164c8d |
135 | |
538499df |
136 | my $output = $tps->output; |
137 | $output =~ s/\n\n+/\n/g; |
26164c8d |
138 | |
538499df |
139 | is( $output, <<'EOF', 'output returns expected report' ); |
140 | That TPS Report |
141 | I celebrate his whole collection! |
142 | t: PC Load Letter |
143 | p: Swingline |
144 | s: flair! |
145 | Written by Peter Gibbons (for Bill Lumberg) |
146 | EOF |
26164c8d |
147 | } |
148 | |
ad648c43 |
149 | sub tests05 { |
00c47fc4 |
150 | has_meta('Person'); |
151 | has_meta('Employee'); |
152 | no_droppings('Employee'); |
ad648c43 |
153 | |
70eec86e |
154 | for my $attr_name (qw( first_name last_name title )) { |
ad648c43 |
155 | my $attr = Person->meta->get_attribute($attr_name); |
156 | |
70eec86e |
157 | ok( |
158 | $attr->has_type_constraint, |
159 | "Person $attr_name has a type constraint" |
160 | ); |
161 | is( |
162 | $attr->type_constraint->name, 'Str', |
163 | "Person $attr_name type is Str" |
164 | ); |
ad648c43 |
165 | } |
166 | |
167 | { |
168 | my $salary_level_attr = Employee->meta->get_attribute('salary_level'); |
70eec86e |
169 | ok( |
170 | $salary_level_attr->has_type_constraint, |
171 | 'Employee salary_level has a type constraint' |
172 | ); |
ad648c43 |
173 | |
174 | my $tc = $salary_level_attr->type_constraint; |
175 | |
176 | for my $invalid ( 0, 11, -14, 'foo', undef ) { |
177 | my $str = defined $invalid ? $invalid : 'undef'; |
70eec86e |
178 | ok( |
179 | !$tc->check($invalid), |
180 | "salary_level type rejects invalid value - $str" |
181 | ); |
ad648c43 |
182 | } |
183 | |
70eec86e |
184 | for my $valid ( 1 .. 10 ) { |
185 | ok( |
186 | $tc->check($valid), |
187 | "salary_level type accepts valid value - $valid" |
188 | ); |
ad648c43 |
189 | } |
190 | } |
191 | |
192 | { |
193 | my $salary_attr = Employee->meta->get_attribute('salary'); |
194 | |
70eec86e |
195 | ok( |
196 | $salary_attr->has_type_constraint, |
197 | 'Employee salary has a type constraint' |
198 | ); |
ad648c43 |
199 | |
200 | my $tc = $salary_attr->type_constraint; |
201 | |
202 | for my $invalid ( 0, -14, 'foo', undef ) { |
203 | my $str = defined $invalid ? $invalid : 'undef'; |
70eec86e |
204 | ok( |
205 | !$tc->check($invalid), |
206 | "salary type rejects invalid value - $str" |
207 | ); |
ad648c43 |
208 | } |
209 | |
210 | for my $valid ( 1, 100_000, 10**10 ) { |
70eec86e |
211 | ok( |
212 | $tc->check($valid), |
213 | "salary type accepts valid value - $valid" |
214 | ); |
ad648c43 |
215 | } |
216 | } |
217 | |
218 | { |
219 | my $ssn_attr = Employee->meta->get_attribute('ssn'); |
220 | |
70eec86e |
221 | ok( |
222 | $ssn_attr->has_type_constraint, |
223 | 'Employee ssn has a type constraint' |
224 | ); |
ad648c43 |
225 | |
226 | my $tc = $ssn_attr->type_constraint; |
227 | |
228 | for my $invalid ( 0, -14, 'foo', undef, '123-ab-1241', '123456789' ) { |
229 | my $str = defined $invalid ? $invalid : 'undef'; |
70eec86e |
230 | ok( |
231 | !$tc->check($invalid), |
232 | "ssn type rejects invalid value - $str" |
233 | ); |
ad648c43 |
234 | } |
235 | |
236 | for my $valid ( '041-12-1251', '123-45-6789', '926-41-5820' ) { |
70eec86e |
237 | ok( |
238 | $tc->check($valid), |
239 | "ssn type accepts valid value - $valid" |
240 | ); |
ad648c43 |
241 | } |
242 | } |
243 | } |
244 | |
66b226e5 |
245 | sub tests06 { |
00c47fc4 |
246 | has_meta('Person'); |
247 | has_meta('Employee'); |
248 | has_meta('BankAccount'); |
249 | no_droppings('BankAccount'); |
66b226e5 |
250 | |
00c47fc4 |
251 | has_rw_attr( 'BankAccount', 'balance' ); |
252 | has_rw_attr( 'BankAccount', 'owner' ); |
253 | has_ro_attr( 'BankAccount', 'history' ); |
66b226e5 |
254 | |
36e1e336 |
255 | my $ba_meta = BankAccount->meta; |
70eec86e |
256 | ok( |
257 | $ba_meta->has_attribute('balance'), |
258 | 'BankAccount class has a balance attribute' |
259 | ); |
36e1e336 |
260 | |
ed84c5c6 |
261 | my $history_attr = $ba_meta->get_attribute('history'); |
262 | |
263 | ok( |
264 | $history_attr->meta() |
265 | ->does_role('Moose::Meta::Attribute::Native::Trait::Array'), |
266 | 'BankAccount history attribute uses native delegation to an array ref' |
267 | ); |
268 | |
70eec86e |
269 | ok( |
270 | $ba_meta->get_attribute('balance')->has_trigger, |
271 | 'BankAccount balance attribute has a trigger' |
272 | ); |
36e1e336 |
273 | |
66b226e5 |
274 | my $person_meta = Person->meta; |
70eec86e |
275 | ok( |
276 | !$person_meta->has_attribute('balance'), |
277 | 'Person class does not have a balance attribute' |
278 | ); |
66b226e5 |
279 | |
280 | my $deposit_meth = $person_meta->get_method('deposit'); |
281 | isa_ok( $deposit_meth, 'Moose::Meta::Method::Delegation' ); |
282 | |
283 | my $withdraw_meth = $person_meta->get_method('withdraw'); |
284 | isa_ok( $withdraw_meth, 'Moose::Meta::Method::Delegation' ); |
285 | |
70eec86e |
286 | ok( |
287 | $ba_meta->get_attribute('owner')->is_weak_ref, |
288 | 'owner attribute is a weak ref' |
289 | ); |
66b226e5 |
290 | |
291 | person06(); |
292 | } |
293 | |
ddd87d75 |
294 | sub has_meta { |
70eec86e |
295 | my $package = shift; |
ddd87d75 |
296 | |
00c47fc4 |
297 | local $Test::Builder::Level = $Test::Builder::Level + 1; |
298 | |
70eec86e |
299 | use_ok($package) |
300 | or BAIL_OUT("$package cannot be loaded"); |
5c7cd208 |
301 | |
70eec86e |
302 | ok( $package->can('meta'), "$package has a meta() method" ) |
303 | or BAIL_OUT( |
304 | "$package does not have a meta() method (did you forget to 'use Moose'?)" |
305 | ); |
ddd87d75 |
306 | } |
307 | |
308 | sub check_isa { |
309 | my $class = shift; |
310 | my $parents = shift; |
311 | |
00c47fc4 |
312 | local $Test::Builder::Level = $Test::Builder::Level + 1; |
313 | |
ddd87d75 |
314 | my @isa = $class->meta->linearized_isa; |
315 | shift @isa; # returns $class as the first entry |
316 | |
317 | my $count = scalar @{$parents}; |
318 | my $noun = PL_N( 'parent', $count ); |
319 | |
320 | is( scalar @isa, $count, "$class has $count $noun" ); |
321 | |
322 | for ( my $i = 0; $i < @{$parents}; $i++ ) { |
323 | is( $isa[$i], $parents->[$i], "parent[$i] is $parents->[$i]" ); |
324 | } |
325 | } |
326 | |
ddd87d75 |
327 | sub has_rw_attr { |
605c1144 |
328 | my $class = shift; |
329 | my $name = shift; |
330 | my $overridden = shift; |
ddd87d75 |
331 | |
00c47fc4 |
332 | local $Test::Builder::Level = $Test::Builder::Level + 1; |
333 | |
605c1144 |
334 | my $articled = $overridden ? "an overridden $name" : A($name); |
70eec86e |
335 | ok( |
336 | $class->meta->has_attribute($name), |
337 | "$class has $articled attribute" |
338 | ); |
ddd87d75 |
339 | |
340 | my $attr = $class->meta->get_attribute($name); |
341 | |
70eec86e |
342 | is( |
343 | $attr->get_read_method, $name, |
344 | "$name attribute has a reader accessor - $name()" |
345 | ); |
346 | is( |
347 | $attr->get_write_method, $name, |
348 | "$name attribute has a writer accessor - $name()" |
349 | ); |
ddd87d75 |
350 | } |
351 | |
352 | sub has_ro_attr { |
353 | my $class = shift; |
354 | my $name = shift; |
355 | |
00c47fc4 |
356 | local $Test::Builder::Level = $Test::Builder::Level + 1; |
357 | |
8d1ce1d7 |
358 | my $articled = A($name); |
70eec86e |
359 | ok( |
360 | $class->meta->has_attribute($name), |
361 | "$class has $articled attribute" |
362 | ); |
ddd87d75 |
363 | |
364 | my $attr = $class->meta->get_attribute($name); |
365 | |
70eec86e |
366 | is( |
367 | $attr->get_read_method, $name, |
368 | "$name attribute has a reader accessor - $name()" |
369 | ); |
370 | is( |
371 | $attr->get_write_method, undef, |
372 | "$name attribute does not have a writer" |
373 | ); |
374 | } |
375 | |
376 | sub has_role_attr { |
377 | my $role = shift; |
378 | my $name = shift; |
379 | |
00c47fc4 |
380 | local $Test::Builder::Level = $Test::Builder::Level + 1; |
381 | |
70eec86e |
382 | my $articled = A($name); |
383 | ok( |
384 | $role->meta->get_attribute($name), |
385 | "$role has $articled attribute" |
386 | ); |
ddd87d75 |
387 | } |
388 | |
389 | sub has_method { |
70eec86e |
390 | my $package = shift; |
391 | my $name = shift; |
ddd87d75 |
392 | |
00c47fc4 |
393 | local $Test::Builder::Level = $Test::Builder::Level + 1; |
394 | |
8d1ce1d7 |
395 | my $articled = A($name); |
70eec86e |
396 | ok( $package->meta->has_method($name), "$package has $articled method" ); |
ddd87d75 |
397 | } |
398 | |
399 | sub has_overridden_method { |
70eec86e |
400 | my $package = shift; |
401 | my $name = shift; |
ddd87d75 |
402 | |
00c47fc4 |
403 | local $Test::Builder::Level = $Test::Builder::Level + 1; |
404 | |
8d1ce1d7 |
405 | my $articled = A($name); |
70eec86e |
406 | ok( $package->meta->has_method($name), "$package has $articled method" ); |
ddd87d75 |
407 | |
70eec86e |
408 | my $meth = $package->meta->get_method($name); |
ddd87d75 |
409 | isa_ok( $meth, 'Moose::Meta::Method::Overridden' ); |
410 | } |
411 | |
538499df |
412 | sub has_augmented_method { |
413 | my $class = shift; |
414 | my $name = shift; |
415 | |
00c47fc4 |
416 | local $Test::Builder::Level = $Test::Builder::Level + 1; |
417 | |
538499df |
418 | my $articled = A($name); |
419 | ok( $class->meta->has_method($name), "$class has $articled method" ); |
420 | |
421 | my $meth = $class->meta->get_method($name); |
422 | isa_ok( $meth, 'Moose::Meta::Method::Augmented' ); |
423 | } |
424 | |
70eec86e |
425 | sub requires_method { |
426 | my $package = shift; |
427 | my $method = shift; |
428 | |
00c47fc4 |
429 | local $Test::Builder::Level = $Test::Builder::Level + 1; |
430 | |
70eec86e |
431 | ok( |
432 | $package->meta->requires_method($method), |
433 | "$package requires the method $method" |
434 | ); |
435 | } |
436 | |
ddd87d75 |
437 | sub no_droppings { |
70eec86e |
438 | my $package = shift; |
ddd87d75 |
439 | |
00c47fc4 |
440 | local $Test::Builder::Level = $Test::Builder::Level + 1; |
441 | |
70eec86e |
442 | ok( !$package->can('has'), "no Moose droppings in $package" ); |
443 | ok( !$package->can('subtype'), |
444 | "no Moose::Util::TypeConstraints droppings in $package" ); |
ddd87d75 |
445 | } |
446 | |
447 | sub is_immutable { |
448 | my $class = shift; |
449 | |
00c47fc4 |
450 | local $Test::Builder::Level = $Test::Builder::Level + 1; |
451 | |
ddd87d75 |
452 | ok( $class->meta->is_immutable, "$class has been made immutable" ); |
453 | } |
454 | |
5cab7e05 |
455 | sub does_role { |
70eec86e |
456 | my $package = shift; |
457 | my $role = shift; |
5cab7e05 |
458 | |
00c47fc4 |
459 | local $Test::Builder::Level = $Test::Builder::Level + 1; |
460 | |
70eec86e |
461 | ok( $package->meta->does_role($role), "$package does the $role role" ); |
5cab7e05 |
462 | } |
463 | |
ddd87d75 |
464 | sub person01 { |
465 | my $person = Person->new( |
466 | first_name => 'Bilbo', |
467 | last_name => 'Baggins', |
468 | ); |
469 | |
70eec86e |
470 | is( |
471 | $person->full_name, 'Bilbo Baggins', |
472 | 'full_name() is correctly implemented' |
473 | ); |
f7da468c |
474 | |
d047d1d4 |
475 | $person = eval { Person->new( [ qw( Lisa Smith ) ] ) }; |
476 | ok( !$@, 'Person->new() can accept an array reference as an argument' ) |
477 | or BAIL_OUT( |
478 | 'You must implement Person->BUILDARGS in order to continue these tests' |
479 | ); |
480 | |
f7da468c |
481 | is( $person->first_name, 'Lisa', 'set first_name from two-arg arrayref' ); |
482 | is( $person->last_name, 'Smith', 'set last_name from two-arg arrayref' ); |
483 | |
70eec86e |
484 | eval { |
485 | Person->new( sub {'foo'} ); |
486 | }; |
487 | like( |
488 | $@, qr/\QSingle parameters to new() must be a HASH ref/, |
489 | 'Person constructor still rejects bad parameters' |
490 | ); |
ddd87d75 |
491 | } |
492 | |
493 | sub employee01 { |
494 | my $employee = Employee->new( |
495 | first_name => 'Amanda', |
496 | last_name => 'Palmer', |
8d1ce1d7 |
497 | title => 'Singer', |
ddd87d75 |
498 | ); |
499 | |
70eec86e |
500 | my $called = 0; |
54b470f5 |
501 | my $orig_super = \&Employee::super; |
502 | no warnings 'redefine'; |
503 | local *Employee::super = sub { $called++; goto &$orig_super }; |
504 | |
70eec86e |
505 | is( |
506 | $employee->full_name, 'Amanda Palmer (Singer)', |
507 | 'full_name() is properly overriden in Employee' |
508 | ); |
54b470f5 |
509 | ok( $called, 'Employee->full_name calls super()' ); |
ddd87d75 |
510 | } |
511 | |
5cab7e05 |
512 | sub person02 { |
513 | my $person = Person->new( |
514 | first_name => 'Bilbo', |
515 | last_name => 'Baggins', |
516 | balance => 0, |
517 | ); |
518 | |
70eec86e |
519 | is( |
520 | $person->as_string, 'Bilbo Baggins', |
521 | 'as_string() is correctly implemented' |
522 | ); |
5cab7e05 |
523 | |
524 | account_tests($person); |
525 | } |
526 | |
527 | sub employee02 { |
528 | my $employee = Employee->new( |
529 | first_name => 'Amanda', |
530 | last_name => 'Palmer', |
8d1ce1d7 |
531 | title => 'Singer', |
5cab7e05 |
532 | balance => 0, |
533 | ); |
534 | |
70eec86e |
535 | is( |
536 | $employee->as_string, 'Amanda Palmer (Singer)', |
537 | 'as_string() uses overridden full_name method in Employee' |
538 | ); |
5cab7e05 |
539 | |
540 | account_tests($employee); |
541 | } |
542 | |
8d1ce1d7 |
543 | sub person03 { |
544 | my $person = Person->new( |
545 | first_name => 'Bilbo', |
546 | last_name => 'Baggins', |
547 | ); |
548 | |
70eec86e |
549 | is( |
550 | $person->full_name, 'Bilbo Baggins', |
551 | 'full_name() is correctly implemented for a Person without a title' |
552 | ); |
553 | ok( |
554 | !$person->has_title, |
555 | 'Person has_title predicate is working correctly (returns false)' |
556 | ); |
8d1ce1d7 |
557 | |
558 | $person->title('Ringbearer'); |
70eec86e |
559 | ok( $person->has_title, |
560 | 'Person has_title predicate is working correctly (returns true)' ); |
3647da1b |
561 | |
70eec86e |
562 | my $called = 0; |
54b470f5 |
563 | my $orig_pred = \&Person::has_title; |
564 | no warnings 'redefine'; |
565 | local *Person::has_title = sub { $called++; goto &$orig_pred }; |
566 | |
70eec86e |
567 | is( |
568 | $person->full_name, 'Bilbo Baggins (Ringbearer)', |
569 | 'full_name() is correctly implemented for a Person with a title' |
570 | ); |
571 | ok( $called, |
572 | 'full_name in person uses the predicate for the title attribute' ); |
8d1ce1d7 |
573 | |
574 | $person->clear_title; |
575 | ok( !$person->has_title, 'Person clear_title method cleared the title' ); |
576 | |
577 | account_tests( $person, 100 ); |
578 | } |
579 | |
580 | sub employee03 { |
581 | my $employee = Employee->new( |
582 | first_name => 'Jimmy', |
583 | last_name => 'Foo', |
584 | salary_level => 3, |
585 | salary => 42, |
586 | ); |
587 | |
70eec86e |
588 | is( |
589 | $employee->salary, 30000, |
590 | 'salary is calculated from salary_level, and salary passed to constructor is ignored' |
591 | ); |
8d1ce1d7 |
592 | } |
593 | |
66b226e5 |
594 | sub person06 { |
595 | my $person = Person->new( |
596 | first_name => 'Bilbo', |
597 | last_name => 'Baggins', |
598 | ); |
599 | |
600 | isa_ok( $person->account, 'BankAccount' ); |
70eec86e |
601 | is( |
602 | $person->account->owner, $person, |
603 | 'owner of bank account is person that created account' |
604 | ); |
66b226e5 |
605 | |
606 | $person->deposit(10); |
70eec86e |
607 | is_deeply( |
608 | $person->account->history, [100], |
609 | 'deposit was recorded in account history' |
610 | ); |
66b226e5 |
611 | |
612 | $person->withdraw(15); |
70eec86e |
613 | is_deeply( |
614 | $person->account->history, [ 100, 110 ], |
615 | 'withdrawal was recorded in account history' |
616 | ); |
648519ab |
617 | |
618 | $person->withdraw(45); |
70eec86e |
619 | is_deeply( |
620 | $person->account->history, [ 100, 110, 95 ], |
621 | 'withdrawal was recorded in account history' |
622 | ); |
66b226e5 |
623 | } |
624 | |
5cab7e05 |
625 | sub account_tests { |
626 | local $Test::Builder::Level = $Test::Builder::Level + 1; |
627 | |
628 | my $person = shift; |
8d1ce1d7 |
629 | my $base_amount = shift || 0; |
5cab7e05 |
630 | |
631 | $person->deposit(50); |
8d1ce1d7 |
632 | eval { $person->withdraw( 75 + $base_amount ) }; |
70eec86e |
633 | like( |
634 | $@, qr/\QBalance cannot be negative/, |
635 | 'cannot withdraw more than is in our balance' |
636 | ); |
5cab7e05 |
637 | |
70eec86e |
638 | $person->withdraw(23); |
5cab7e05 |
639 | |
70eec86e |
640 | is( |
641 | $person->balance, 27 + $base_amount, |
642 | 'balance is 27 (+ starting balance) after deposit of 50 and withdrawal of 23' |
643 | ); |
5cab7e05 |
644 | } |
ddd87d75 |
645 | |
646 | 1; |