9 plan skip_all => "segv happens on 5.6.2";
13 use lib 't/lib', 'lib';
15 use Test::More tests => 32;
19 package My::SimpleTrait;
23 sub simple { return 5 }
29 use Mouse -traits => [ 'My::SimpleTrait' ];
32 can_ok( Foo->meta(), 'simple' );
33 is( Foo->meta()->simple(), 5,
34 'Foo->meta()->simple() returns expected value' );
39 use Mouse -traits => 'My::SimpleTrait';
42 can_ok( Bar->meta(), 'simple' );
43 is( Bar->meta()->simple(), 5,
44 'Foo->meta()->simple() returns expected value' );
47 package My::SimpleTrait2;
51 # This needs to happen at compile time so it happens before we
56 default => 'something',
60 sub simple { return 5 }
66 use Mouse -traits => [ 'My::SimpleTrait2' ];
69 can_ok( Bar->meta(), 'simple' );
70 is( Bar->meta()->simple(), 5,
71 'Bar->meta()->simple() returns expected value' );
72 can_ok( Bar->meta(), 'attr' );
73 is( Bar->meta()->attr(), 'something',
74 'Bar->meta()->attr() returns expected value' );
77 package My::SimpleTrait3;
84 default => 'something',
88 sub simple2 { return 55 }
94 use Mouse -traits => [ 'My::SimpleTrait2', 'My::SimpleTrait3' ];
97 can_ok( Baz->meta(), 'simple' );
98 is( Baz->meta()->simple(), 5,
99 'Baz->meta()->simple() returns expected value' );
100 can_ok( Baz->meta(), 'attr' );
101 is( Baz->meta()->attr(), 'something',
102 'Baz->meta()->attr() returns expected value' );
103 can_ok( Baz->meta(), 'simple2' );
104 is( Baz->meta()->simple2(), 55,
105 'Baz->meta()->simple2() returns expected value' );
106 can_ok( Baz->meta(), 'attr2' );
107 is( Baz->meta()->attr2(), 'something',
108 'Baz->meta()->attr2() returns expected value' );
111 package My::Trait::AlwaysRO;
115 around '_process_new_attribute', '_process_inherited_attribute' =>
118 my ( $self, $name, %args ) = @_;
122 return $self->$orig( $name, %args );
129 use Mouse -traits => [ 'My::Trait::AlwaysRO' ];
137 ok( Quux->meta()->has_attribute('size'),
138 'Quux has size attribute' );
139 ok( ! Quux->meta()->get_attribute('size')->writer(),
140 'size attribute does not have a writer' );
143 package My::Class::Whatever;
149 package Mouse::Meta::Class::Custom::Trait::Whatever;
151 sub register_implementation {
152 return 'My::Class::Whatever';
157 package RanOutOfNames;
159 use Mouse -traits => [ 'Whatever' ];
162 ok( RanOutOfNames->meta()->meta()->has_method('whatever'),
163 'RanOutOfNames->meta() has whatever method' );
168 use Mouse::Role -traits => [ 'My::SimpleTrait' ];
171 can_ok( Role::Foo->meta(), 'simple' );
172 is( Role::Foo->meta()->simple(), 5,
173 'Role::Foo->meta()->simple() returns expected value' );
176 require Mouse::Util::TypeConstraints;
177 dies_ok( sub { Mouse::Util::TypeConstraints->import( -traits => 'My::SimpleTrait' ) },
178 'cannot provide -traits to an exporting module that does not init_meta' );
179 like( $@, qr/does not have an init_meta/,
180 '... and error provides a useful explanation' );
185 package Foo::Subclass;
187 use Mouse -traits => [ 'My::SimpleTrait3' ];
192 can_ok( Foo::Subclass->meta(), 'simple' );
193 is( Foo::Subclass->meta()->simple(), 5,
194 'Foo::Subclass->meta()->simple() returns expected value' );
195 is( Foo::Subclass->meta()->simple2(), 55,
196 'Foo::Subclass->meta()->simple2() returns expected value' );
197 can_ok( Foo::Subclass->meta(), 'attr2' );
198 is( Foo::Subclass->meta()->attr2(), 'something',
199 'Foo::Subclass->meta()->attr2() returns expected value' );
203 package Class::WithAlreadyPresentTrait;
204 use Mouse -traits => 'My::SimpleTrait';
206 has an_attr => ( is => 'ro' );
210 my $instance = Class::WithAlreadyPresentTrait->new( an_attr => 'value' );
211 is( $instance->an_attr, 'value', 'Can get value' );
213 'Can create instance and access attributes';
217 package Class::WhichLoadsATraitFromDisk;
219 # Any role you like here, the only important bit is that it gets
220 # loaded from disk and has not already been defined.
221 use Mouse -traits => 'Role::Parent';
223 has an_attr => ( is => 'ro' );
227 my $instance = Class::WhichLoadsATraitFromDisk->new( an_attr => 'value' );
228 is( $instance->an_attr, 'value', 'Can get value' );
230 'Can create instance and access attributes';