Require Dist::Zilla 4.200016+
[gitmo/Moose.git] / t / cmop / add_method_modifier.t
CommitLineData
38bf2a25 1use strict;
2use warnings;
3
4use Test::More;
5use Test::Fatal;
6
7use Class::MOP;
8
9{
10
11 package BankAccount;
12
13 use strict;
14 use warnings;
15 use metaclass;
16
17 use Carp 'confess';
18
19 BankAccount->meta->add_attribute(
20 'balance' => (
21 accessor => 'balance',
22 init_arg => 'balance',
23 default => 0
24 )
25 );
26
27 sub new { (shift)->meta->new_object(@_) }
28
29 sub deposit {
30 my ( $self, $amount ) = @_;
31 $self->balance( $self->balance + $amount );
32 }
33
34 sub withdraw {
35 my ( $self, $amount ) = @_;
36 my $current_balance = $self->balance();
37 ( $current_balance >= $amount )
38 || confess "Account overdrawn";
39 $self->balance( $current_balance - $amount );
40 }
41
42 package CheckingAccount;
43
44 use strict;
45 use warnings;
46 use metaclass;
47
48 use base 'BankAccount';
49
50 CheckingAccount->meta->add_attribute(
51 'overdraft_account' => (
52 accessor => 'overdraft_account',
53 init_arg => 'overdraft',
54 )
55 );
56
57 CheckingAccount->meta->add_before_method_modifier(
58 'withdraw' => sub {
59 my ( $self, $amount ) = @_;
60 my $overdraft_amount = $amount - $self->balance();
61 if ( $overdraft_amount > 0 ) {
62 $self->overdraft_account->withdraw($overdraft_amount);
63 $self->deposit($overdraft_amount);
64 }
65 }
66 );
67
68 ::like(
69 ::exception{ CheckingAccount->meta->add_before_method_modifier(
70 'does_not_exist' => sub { }
71 );
72 },
73 qr/\QThe method 'does_not_exist' was not found in the inheritance hierarchy for CheckingAccount/
74 );
75
76 ::ok( CheckingAccount->meta->has_method('withdraw'),
77 '... checking account now has a withdraw method' );
78 ::isa_ok( CheckingAccount->meta->get_method('withdraw'),
79 'Class::MOP::Method::Wrapped' );
80 ::isa_ok( BankAccount->meta->get_method('withdraw'),
81 'Class::MOP::Method' );
82
83 CheckingAccount->meta->add_method( foo => sub { 'foo' } );
84 CheckingAccount->meta->add_before_method_modifier( foo => sub { 'wrapped' } );
85 ::isa_ok( CheckingAccount->meta->get_method('foo'),
86 'Class::MOP::Method::Wrapped' );
87}
88
89my $savings_account = BankAccount->new( balance => 250 );
90isa_ok( $savings_account, 'BankAccount' );
91
92is( $savings_account->balance, 250, '... got the right savings balance' );
93is( exception {
94 $savings_account->withdraw(50);
95}, undef, '... withdrew from savings successfully' );
96is( $savings_account->balance, 200,
97 '... got the right savings balance after withdrawal' );
98isnt( exception {
99 $savings_account->withdraw(250);
100}, undef, '... could not withdraw from savings successfully' );
101
102$savings_account->deposit(150);
103is( $savings_account->balance, 350,
104 '... got the right savings balance after deposit' );
105
106my $checking_account = CheckingAccount->new(
107 balance => 100,
108 overdraft => $savings_account
109);
110isa_ok( $checking_account, 'CheckingAccount' );
111isa_ok( $checking_account, 'BankAccount' );
112
113is( $checking_account->overdraft_account, $savings_account,
114 '... got the right overdraft account' );
115
116is( $checking_account->balance, 100, '... got the right checkings balance' );
117
118is( exception {
119 $checking_account->withdraw(50);
120}, undef, '... withdrew from checking successfully' );
121is( $checking_account->balance, 50,
122 '... got the right checkings balance after withdrawal' );
123is( $savings_account->balance, 350,
124 '... got the right savings balance after checking withdrawal (no overdraft)'
125);
126
127is( exception {
128 $checking_account->withdraw(200);
129}, undef, '... withdrew from checking successfully' );
130is( $checking_account->balance, 0,
131 '... got the right checkings balance after withdrawal' );
132is( $savings_account->balance, 200,
133 '... got the right savings balance after overdraft withdrawal' );
134
135done_testing;