Commit | Line | Data |
5b5187e0 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
8ad91ed8 |
6 | use Test::More tests => 28; |
f9dfa78b |
7 | use Test::Exception; |
5b5187e0 |
8 | |
9 | { |
10 | package My::SimpleTrait; |
11 | |
12 | use Moose::Role; |
13 | |
14 | sub simple { return 5 } |
15 | } |
16 | |
17 | { |
18 | package Foo; |
19 | |
20 | use Moose -traits => [ 'My::SimpleTrait' ]; |
21 | } |
22 | |
23 | can_ok( Foo->meta(), 'simple' ); |
24 | is( Foo->meta()->simple(), 5, |
25 | 'Foo->meta()->simple() returns expected value' ); |
26 | |
27 | { |
f9dfa78b |
28 | package Bar; |
29 | |
30 | use Moose -traits => 'My::SimpleTrait'; |
31 | } |
32 | |
33 | can_ok( Bar->meta(), 'simple' ); |
34 | is( Bar->meta()->simple(), 5, |
35 | 'Foo->meta()->simple() returns expected value' ); |
36 | |
37 | { |
5b5187e0 |
38 | package My::SimpleTrait2; |
39 | |
40 | use Moose::Role; |
41 | |
42 | # This needs to happen at compile time so it happens before we |
43 | # apply traits to Bar |
44 | BEGIN { |
45 | has 'attr' => |
46 | ( is => 'ro', |
47 | default => 'something', |
48 | ); |
49 | } |
50 | |
51 | sub simple { return 5 } |
52 | } |
53 | |
54 | { |
55 | package Bar; |
56 | |
57 | use Moose -traits => [ 'My::SimpleTrait2' ]; |
58 | } |
59 | |
60 | can_ok( Bar->meta(), 'simple' ); |
61 | is( Bar->meta()->simple(), 5, |
62 | 'Bar->meta()->simple() returns expected value' ); |
63 | can_ok( Bar->meta(), 'attr' ); |
64 | is( Bar->meta()->attr(), 'something', |
65 | 'Bar->meta()->attr() returns expected value' ); |
66 | |
67 | { |
68 | package My::SimpleTrait3; |
69 | |
70 | use Moose::Role; |
71 | |
72 | BEGIN { |
73 | has 'attr2' => |
74 | ( is => 'ro', |
75 | default => 'something', |
76 | ); |
77 | } |
78 | |
79 | sub simple2 { return 55 } |
80 | } |
81 | |
82 | { |
83 | package Baz; |
84 | |
85 | use Moose -traits => [ 'My::SimpleTrait2', 'My::SimpleTrait3' ]; |
86 | } |
87 | |
88 | can_ok( Baz->meta(), 'simple' ); |
89 | is( Baz->meta()->simple(), 5, |
90 | 'Baz->meta()->simple() returns expected value' ); |
91 | can_ok( Baz->meta(), 'attr' ); |
92 | is( Baz->meta()->attr(), 'something', |
93 | 'Baz->meta()->attr() returns expected value' ); |
94 | can_ok( Baz->meta(), 'simple2' ); |
95 | is( Baz->meta()->simple2(), 55, |
96 | 'Baz->meta()->simple2() returns expected value' ); |
97 | can_ok( Baz->meta(), 'attr2' ); |
98 | is( Baz->meta()->attr2(), 'something', |
99 | 'Baz->meta()->attr2() returns expected value' ); |
100 | |
101 | { |
102 | package My::Trait::AlwaysRO; |
103 | |
104 | use Moose::Role; |
105 | |
106 | around '_process_new_attribute', '_process_inherited_attribute' => |
107 | sub { |
108 | my $orig = shift; |
109 | my ( $self, $name, %args ) = @_; |
110 | |
111 | $args{is} = 'ro'; |
112 | |
113 | return $self->$orig( $name, %args ); |
114 | }; |
115 | } |
116 | |
117 | { |
118 | package Quux; |
119 | |
120 | use Moose -traits => [ 'My::Trait::AlwaysRO' ]; |
121 | |
122 | has 'size' => |
123 | ( is => 'rw', |
124 | isa => 'Int', |
125 | ); |
126 | } |
127 | |
128 | ok( Quux->meta()->has_attribute('size'), |
129 | 'Quux has size attribute' ); |
130 | ok( ! Quux->meta()->get_attribute('size')->writer(), |
131 | 'size attribute does not have a writer' ); |
132 | |
133 | { |
134 | package My::Class::Whatever; |
135 | |
136 | use Moose::Role; |
137 | |
138 | sub whatever { 42 } |
139 | |
140 | package Moose::Meta::Class::Custom::Trait::Whatever; |
141 | |
142 | sub register_implementation { |
143 | return 'My::Class::Whatever'; |
144 | } |
145 | } |
146 | |
147 | { |
148 | package RanOutOfNames; |
149 | |
150 | use Moose -traits => [ 'Whatever' ]; |
151 | } |
152 | |
153 | ok( RanOutOfNames->meta()->meta()->has_method('whatever'), |
154 | 'RanOutOfNames->meta() has whatever method' ); |
155 | |
156 | { |
157 | package Role::Foo; |
158 | |
159 | use Moose::Role -traits => [ 'My::SimpleTrait' ]; |
160 | } |
161 | |
162 | can_ok( Role::Foo->meta(), 'simple' ); |
163 | is( Role::Foo->meta()->simple(), 5, |
164 | 'Role::Foo->meta()->simple() returns expected value' ); |
f9dfa78b |
165 | |
166 | { |
167 | require Moose::Util::TypeConstraints; |
168 | dies_ok( sub { Moose::Util::TypeConstraints->import( -traits => 'My::SimpleTrait' ) }, |
169 | 'cannot provide -traits to an exporting module that does not init_meta' ); |
170 | like( $@, qr/does not have an init_meta/, |
171 | '... and error provides a useful explanation' ); |
172 | } |
8ad91ed8 |
173 | |
174 | SKIP: |
175 | { |
176 | skip 'This will blow up until Moose::Meta::Class->_fix_metaclass_incompatibility understands roles', 5; |
177 | { |
178 | package Foo::Subclass; |
179 | |
180 | use Moose -traits => [ 'My::SimpleTrait3' ]; |
181 | |
182 | extends 'Foo'; |
183 | } |
184 | |
185 | can_ok( Foo::Subclass->meta(), 'simple' ); |
186 | is( Foo::Subclass->meta()->simple(), 5, |
187 | 'Foo::Subclass->meta()->simple() returns expected value' ); |
188 | is( Foo::Subclass->meta()->simple2(), 55, |
189 | 'Foo::Subclass->meta()->simple2() returns expected value' ); |
190 | can_ok( Foo::Subclass->meta(), 'attr2' ); |
191 | is( Foo::Subclass->meta()->attr2(), 'something', |
192 | 'Foo::Subclass->meta()->attr2() returns expected value' ); |
193 | } |