4 use Test::More tests => 7;
8 local $SIG{__WARN__} = sub{ $_[0] =~ /deprecated/ or warn @_ };
10 package MouseX::AttributeHelpers::Number;
12 extends 'Mouse::Meta::Attribute';
15 my ($self, @args) = @_;
16 my $attr = $self->SUPER::create(@args);
17 my %provides = %{$attr->{provides}};
18 my $method_constructors = {
20 my ($attr, $name) = @_;
22 $_[0]->$name( $_[0]->$name() + $_[1])
26 while (my ($name, $aliased) = each %provides) {
27 $attr->associated_class->add_method(
28 $aliased => $method_constructors->{$name}->($attr, $attr->name)
34 package # hide me from search.cpan.org
35 Mouse::Meta::Attribute::Custom::Number;
36 sub register_implementation { 'MouseX::AttributeHelpers::Number' }
44 metaclass => 'Number',
57 metaclass => 'Number',
61 'add' => 'add_number_j'
78 can_ok 'Klass1', 'add_number';
79 my $k = Klass1->new(i=>3);
86 can_ok 'Klass2', 'f_m';
87 can_ok 'Klass2', 'b_m';
88 can_ok 'Klass2', 'add_number';
89 can_ok 'Klass2', 'add_number_j';
90 my $k = Klass2->new(i=>3);