Commit | Line | Data |
3bb22459 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
39d37838 |
6 | use Test::More tests => 13; |
3bb22459 |
7 | use Test::Exception; |
8 | use Test::Moose; |
9 | |
10 | BEGIN { |
11 | use_ok('Moose'); |
12 | } |
13 | |
14 | { |
15 | package My::Attribute::Trait; |
16 | use Moose::Role; |
17 | |
18 | has 'alias_to' => (is => 'ro', isa => 'Str'); |
19 | |
20 | after 'install_accessors' => sub { |
21 | my $self = shift; |
22 | $self->associated_class->add_method( |
23 | $self->alias_to, |
24 | $self->get_read_method_ref |
25 | ); |
26 | }; |
27 | |
28 | package Moose::Meta::Attribute::Custom::Trait::Aliased; |
29 | sub register_implementation { 'My::Attribute::Trait' } |
30 | } |
31 | |
32 | { |
39d37838 |
33 | package My::Other::Attribute::Trait; |
34 | use Moose::Role; |
35 | |
36 | my $method = sub { |
37 | 42; |
38 | }; |
39 | |
40 | after 'install_accessors' => sub { |
41 | my $self = shift; |
42 | $self->associated_class->add_method( |
43 | 'additional_method', |
44 | $method |
45 | ); |
46 | }; |
47 | |
48 | package Moose::Meta::Attribute::Custom::Trait::Other; |
49 | sub register_implementation { 'My::Other::Attribute::Trait' } |
50 | } |
51 | |
52 | { |
3bb22459 |
53 | package My::Class; |
54 | use Moose; |
55 | |
56 | has 'bar' => ( |
57 | traits => [qw/Aliased/], |
58 | is => 'ro', |
59 | isa => 'Int', |
60 | alias_to => 'baz', |
61 | ); |
62 | } |
63 | |
39d37838 |
64 | { |
65 | package My::Derived::Class; |
66 | use Moose; |
67 | |
68 | extends 'My::Class'; |
69 | |
70 | has '+bar' => ( |
71 | traits => [qw/Other/], |
72 | ); |
73 | } |
74 | |
3bb22459 |
75 | my $c = My::Class->new(bar => 100); |
76 | isa_ok($c, 'My::Class'); |
77 | |
78 | is($c->bar, 100, '... got the right value for bar'); |
79 | |
39d37838 |
80 | can_ok($c, 'baz') and |
3bb22459 |
81 | is($c->baz, 100, '... got the right value for baz'); |
82 | |
83 | does_ok($c->meta->get_attribute('bar'), 'My::Attribute::Trait'); |
39d37838 |
84 | |
85 | my $quux = My::Derived::Class->new(bar => 1000); |
86 | |
87 | is($quux->bar, 1000, '... got the right value for bar'); |
88 | |
89 | can_ok($quux, 'baz'); |
90 | is($quux->baz, 1000, '... got the right value for baz'); |
91 | ok($quux->meta->get_attribute('bar')->does('My::Attribute::Trait')); |
92 | |
93 | TODO: { |
94 | local $TODO = 'These do not pass - bug?'; |
95 | SKIP: { |
96 | skip 'no additional_method, so cannot test its value', 1 if !can_ok($quux, 'additional_method'); |
97 | is($quux->additional_method, 42, '... got the right value for additional_method'); |
98 | } |
99 | ok($quux->meta->get_attribute('bar')->does('My::Other::Attribute::Trait')); |
100 | } |