Make coercion work for parameterized types
[gitmo/Mouse.git] / t / 044-attribute-metaclass.t
CommitLineData
abfdffe0 1#!/usr/bin/env perl
2use strict;
3use warnings;
4use Test::More tests => 2;
5use lib 't/lib';
6
7do {
8 package MouseX::AttributeHelpers::Number;
9 use Mouse;
10 extends 'Mouse::Meta::Attribute';
11
12 around 'create' => sub {
13 my ($next, @args) = @_;
14 my $attr = $next->(@args);
15 my %provides = %{$attr->{provides}};
16 my $method_constructors = {
17 add => sub {
18 my ($attr, $name) = @_;
19 return sub {
20 $_[0]->$name( $_[0]->$name() + $_[1])
21 };
22 },
23 };
24 while (my ($name, $aliased) = each %provides) {
25 $attr->associated_class->add_method(
26 $aliased => $method_constructors->{$name}->($attr, $attr->name)
27 );
28 }
29 return $attr;
30 };
31
32 package # hide me from search.cpan.org
33 Mouse::Meta::Attribute::Custom::Number;
34 sub register_implementation { 'MouseX::AttributeHelpers::Number' }
35
36 1;
37
38 package Klass;
39 use Mouse;
40
41 has 'i' => (
42 metaclass => 'Number',
43 is => 'rw',
44 isa => 'Int',
45 provides => {
46 'add' => 'add_number'
47 },
48 );
49};
50
51can_ok 'Klass', 'add_number';
52my $k = Klass->new(i=>3);
53$k->add_number(4);
54is $k->i, 7;
55