Include method name in immutable methods (fixes #49680)

[gitmo/Class-MOP.git] / t / 017_add_method_modifier.t

use strict;
use warnings;

use Test::More tests => 21;
use Test::Exception;

use Class::MOP;

{

    package BankAccount;

    use strict;
    use warnings;
    use metaclass;

    use Carp 'confess';

    BankAccount->meta->add_attribute(
        'balance' => (
            accessor => 'balance',
            init_arg => 'balance',
            default  => 0
        )
    );

    sub new { (shift)->meta->new_object(@_) }

    sub deposit {
        my ( $self, $amount ) = @_;
        $self->balance( $self->balance + $amount );
    }

    sub withdraw {
        my ( $self, $amount ) = @_;
        my $current_balance = $self->balance();
        ( $current_balance >= $amount )
            || confess "Account overdrawn";
        $self->balance( $current_balance - $amount );
    }

    package CheckingAccount;

    use strict;
    use warnings;
    use metaclass;

    use base 'BankAccount';

    CheckingAccount->meta->add_attribute(
        'overdraft_account' => (
            accessor => 'overdraft_account',
            init_arg => 'overdraft',
        )
    );

    CheckingAccount->meta->add_before_method_modifier(
        'withdraw' => sub {
            my ( $self, $amount ) = @_;
            my $overdraft_amount = $amount - $self->balance();
            if ( $overdraft_amount > 0 ) {
                $self->overdraft_account->withdraw($overdraft_amount);
                $self->deposit($overdraft_amount);
            }
        }
    );

    ::throws_ok(
        sub {
            CheckingAccount->meta->add_before_method_modifier(
                'does_not_exist' => sub { } );
        },
        qr/\QThe method 'does_not_exist' was not found in the inheritance hierarchy for CheckingAccount/
    );

    ::ok( CheckingAccount->meta->has_method('withdraw'),
        '... checking account now has a withdraw method' );
    ::isa_ok( CheckingAccount->meta->get_method('withdraw'),
        'Class::MOP::Method::Wrapped' );
    ::isa_ok( BankAccount->meta->get_method('withdraw'),
        'Class::MOP::Method' );

    CheckingAccount->meta->add_method( foo => sub { 'foo' } );
    CheckingAccount->meta->add_before_method_modifier( foo => sub { 'wrapped' } );
    ::isa_ok( CheckingAccount->meta->get_method('foo'),
        'Class::MOP::Method::Wrapped' );
}

my $savings_account = BankAccount->new( balance => 250 );
isa_ok( $savings_account, 'BankAccount' );

is( $savings_account->balance, 250, '... got the right savings balance' );
lives_ok {
    $savings_account->withdraw(50);
}
'... withdrew from savings successfully';
is( $savings_account->balance, 200,
    '... got the right savings balance after withdrawal' );
dies_ok {
    $savings_account->withdraw(250);
}
'... could not withdraw from savings successfully';

$savings_account->deposit(150);
is( $savings_account->balance, 350,
    '... got the right savings balance after deposit' );

my $checking_account = CheckingAccount->new(
    balance   => 100,
    overdraft => $savings_account
);
isa_ok( $checking_account, 'CheckingAccount' );
isa_ok( $checking_account, 'BankAccount' );

is( $checking_account->overdraft_account, $savings_account,
    '... got the right overdraft account' );

is( $checking_account->balance, 100, '... got the right checkings balance' );

lives_ok {
    $checking_account->withdraw(50);
}
'... withdrew from checking successfully';
is( $checking_account->balance, 50,
    '... got the right checkings balance after withdrawal' );
is( $savings_account->balance, 350,
    '... got the right savings balance after checking withdrawal (no overdraft)'
);

lives_ok {
    $checking_account->withdraw(200);
}
'... withdrew from checking successfully';
is( $checking_account->balance, 0,
    '... got the right checkings balance after withdrawal' );
is( $savings_account->balance, 200,
    '... got the right savings balance after overdraft withdrawal' );