Commit | Line | Data |
3bb22459 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
3c693def |
6 | use Test::More tests => 16; |
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; |
3c693def |
17 | |
3bb22459 |
18 | has 'alias_to' => (is => 'ro', isa => 'Str'); |
3c693def |
19 | |
20 | has foo => ( is => "ro", default => "blah" ); |
21 | |
3bb22459 |
22 | after 'install_accessors' => sub { |
23 | my $self = shift; |
24 | $self->associated_class->add_method( |
3c693def |
25 | $self->alias_to, |
3bb22459 |
26 | $self->get_read_method_ref |
27 | ); |
28 | }; |
3c693def |
29 | |
3bb22459 |
30 | package Moose::Meta::Attribute::Custom::Trait::Aliased; |
31 | sub register_implementation { 'My::Attribute::Trait' } |
32 | } |
33 | |
34 | { |
39d37838 |
35 | package My::Other::Attribute::Trait; |
36 | use Moose::Role; |
3c693def |
37 | |
39d37838 |
38 | my $method = sub { |
39 | 42; |
3c693def |
40 | }; |
41 | |
c32c2c61 |
42 | has the_other_attr => ( isa => "Str", is => "rw", default => "oink" ); |
3c693def |
43 | |
39d37838 |
44 | after 'install_accessors' => sub { |
45 | my $self = shift; |
46 | $self->associated_class->add_method( |
3c693def |
47 | 'additional_method', |
39d37838 |
48 | $method |
49 | ); |
50 | }; |
3c693def |
51 | |
39d37838 |
52 | package Moose::Meta::Attribute::Custom::Trait::Other; |
53 | sub register_implementation { 'My::Other::Attribute::Trait' } |
54 | } |
55 | |
56 | { |
3bb22459 |
57 | package My::Class; |
58 | use Moose; |
3c693def |
59 | |
3bb22459 |
60 | has 'bar' => ( |
61 | traits => [qw/Aliased/], |
62 | is => 'ro', |
63 | isa => 'Int', |
64 | alias_to => 'baz', |
65 | ); |
66 | } |
67 | |
3c693def |
68 | { |
39d37838 |
69 | package My::Derived::Class; |
70 | use Moose; |
71 | |
72 | extends 'My::Class'; |
73 | |
74 | has '+bar' => ( |
75 | traits => [qw/Other/], |
76 | ); |
77 | } |
78 | |
3bb22459 |
79 | my $c = My::Class->new(bar => 100); |
80 | isa_ok($c, 'My::Class'); |
81 | |
82 | is($c->bar, 100, '... got the right value for bar'); |
83 | |
39d37838 |
84 | can_ok($c, 'baz') and |
3bb22459 |
85 | is($c->baz, 100, '... got the right value for baz'); |
86 | |
3c693def |
87 | my $bar_attr = $c->meta->get_attribute('bar'); |
88 | does_ok($bar_attr, 'My::Attribute::Trait'); |
89 | is($bar_attr->foo, "blah", "attr initialized"); |
39d37838 |
90 | |
91 | my $quux = My::Derived::Class->new(bar => 1000); |
92 | |
93 | is($quux->bar, 1000, '... got the right value for bar'); |
94 | |
95 | can_ok($quux, 'baz'); |
96 | is($quux->baz, 1000, '... got the right value for baz'); |
3c693def |
97 | |
98 | my $derived_bar_attr = $quux->meta->get_attribute("bar"); |
99 | does_ok($derived_bar_attr, 'My::Attribute::Trait' ); |
100 | |
101 | is( $derived_bar_attr->foo, "blah", "attr initialized" ); |
39d37838 |
102 | |
c32c2c61 |
103 | does_ok($derived_bar_attr, 'My::Other::Attribute::Trait' ); |
3c693def |
104 | |
c32c2c61 |
105 | is($derived_bar_attr->the_other_attr, "oink", "attr initialized" ); |
106 | |
107 | can_ok($quux, 'additional_method'); |
108 | is(eval { $quux->additional_method }, 42, '... got the right value for additional_method'); |
3c693def |
109 | |