version bump
[gitmo/Moose.git] / t / metaclasses / metaclass_traits.t
1 #!/usr/bin/perl
2
3 use strict;
4 use warnings;
5
6 use lib 't/lib', 'lib';
7
8 use Test::More;
9 use Test::Fatal;
10
11 {
12     package My::SimpleTrait;
13
14     use Moose::Role;
15
16     sub simple { return 5 }
17 }
18
19 {
20     package Foo;
21
22     use Moose -traits => [ 'My::SimpleTrait' ];
23 }
24
25 can_ok( Foo->meta(), 'simple' );
26 is( Foo->meta()->simple(), 5,
27     'Foo->meta()->simple() returns expected value' );
28
29 {
30     package Bar;
31
32     use Moose -traits => 'My::SimpleTrait';
33 }
34
35 can_ok( Bar->meta(), 'simple' );
36 is( Bar->meta()->simple(), 5,
37     'Foo->meta()->simple() returns expected value' );
38
39 {
40     package My::SimpleTrait2;
41
42     use Moose::Role;
43
44     # This needs to happen at compile time so it happens before we
45     # apply traits to Bar
46     BEGIN {
47         has 'attr' =>
48             ( is      => 'ro',
49               default => 'something',
50             );
51     }
52
53     sub simple { return 5 }
54 }
55
56 {
57     package Bar;
58
59     use Moose -traits => [ 'My::SimpleTrait2' ];
60 }
61
62 can_ok( Bar->meta(), 'simple' );
63 is( Bar->meta()->simple(), 5,
64     'Bar->meta()->simple() returns expected value' );
65 can_ok( Bar->meta(), 'attr' );
66 is( Bar->meta()->attr(), 'something',
67     'Bar->meta()->attr() returns expected value' );
68
69 {
70     package My::SimpleTrait3;
71
72     use Moose::Role;
73
74     BEGIN {
75         has 'attr2' =>
76             ( is      => 'ro',
77               default => 'something',
78             );
79     }
80
81     sub simple2 { return 55 }
82 }
83
84 {
85     package Baz;
86
87     use Moose -traits => [ 'My::SimpleTrait2', 'My::SimpleTrait3' ];
88 }
89
90 can_ok( Baz->meta(), 'simple' );
91 is( Baz->meta()->simple(), 5,
92     'Baz->meta()->simple() returns expected value' );
93 can_ok( Baz->meta(), 'attr' );
94 is( Baz->meta()->attr(), 'something',
95     'Baz->meta()->attr() returns expected value' );
96 can_ok( Baz->meta(), 'simple2' );
97 is( Baz->meta()->simple2(), 55,
98     'Baz->meta()->simple2() returns expected value' );
99 can_ok( Baz->meta(), 'attr2' );
100 is( Baz->meta()->attr2(), 'something',
101     'Baz->meta()->attr2() returns expected value' );
102
103 {
104     package My::Trait::AlwaysRO;
105
106     use Moose::Role;
107
108     around '_process_new_attribute', '_process_inherited_attribute' =>
109         sub {
110             my $orig = shift;
111             my ( $self, $name, %args ) = @_;
112
113             $args{is} = 'ro';
114
115             return $self->$orig( $name, %args );
116         };
117 }
118
119 {
120     package Quux;
121
122     use Moose -traits => [ 'My::Trait::AlwaysRO' ];
123
124     has 'size' =>
125         ( is  => 'rw',
126           isa => 'Int',
127         );
128 }
129
130 ok( Quux->meta()->has_attribute('size'),
131     'Quux has size attribute' );
132 ok( ! Quux->meta()->get_attribute('size')->writer(),
133     'size attribute does not have a writer' );
134
135 {
136     package My::Class::Whatever;
137
138     use Moose::Role;
139
140     sub whatever { 42 }
141
142     package Moose::Meta::Class::Custom::Trait::Whatever;
143
144     sub register_implementation {
145         return 'My::Class::Whatever';
146     }
147 }
148
149 {
150     package RanOutOfNames;
151
152     use Moose -traits => [ 'Whatever' ];
153 }
154
155 ok( RanOutOfNames->meta()->meta()->has_method('whatever'),
156     'RanOutOfNames->meta() has whatever method' );
157
158 {
159     package Role::Foo;
160
161     use Moose::Role -traits => [ 'My::SimpleTrait' ];
162 }
163
164 can_ok( Role::Foo->meta(), 'simple' );
165 is( Role::Foo->meta()->simple(), 5,
166     'Role::Foo->meta()->simple() returns expected value' );
167
168 {
169     require Moose::Util::TypeConstraints;
170     like(
171         exception {
172             Moose::Util::TypeConstraints->import(
173                 -traits => 'My::SimpleTrait' );
174         },
175         qr/does not have an init_meta/,
176         'cannot provide -traits to an exporting module that does not init_meta'
177     );
178 }
179
180 {
181     package Foo::Subclass;
182
183     use Moose -traits => [ 'My::SimpleTrait3' ];
184
185     extends 'Foo';
186 }
187
188 can_ok( Foo::Subclass->meta(), 'simple' );
189 is( Foo::Subclass->meta()->simple(), 5,
190     'Foo::Subclass->meta()->simple() returns expected value' );
191 is( Foo::Subclass->meta()->simple2(), 55,
192     'Foo::Subclass->meta()->simple2() returns expected value' );
193 can_ok( Foo::Subclass->meta(), 'attr2' );
194 is( Foo::Subclass->meta()->attr2(), 'something',
195     'Foo::Subclass->meta()->attr2() returns expected value' );
196
197 {
198
199     package Class::WithAlreadyPresentTrait;
200     use Moose -traits => 'My::SimpleTrait';
201
202     has an_attr => ( is => 'ro' );
203 }
204
205 is( exception {
206     my $instance = Class::WithAlreadyPresentTrait->new( an_attr => 'value' );
207     is( $instance->an_attr, 'value', 'Can get value' );
208 }, undef, 'Can create instance and access attributes' );
209
210 {
211
212     package Class::WhichLoadsATraitFromDisk;
213
214     # Any role you like here, the only important bit is that it gets
215     # loaded from disk and has not already been defined.
216     use Moose -traits => 'Role::Parent';
217
218     has an_attr => ( is => 'ro' );
219 }
220
221 is( exception {
222     my $instance = Class::WhichLoadsATraitFromDisk->new( an_attr => 'value' );
223     is( $instance->an_attr, 'value', 'Can get value' );
224 }, undef, 'Can create instance and access attributes' );
225
226 done_testing;