Commit | Line | Data |
5b5187e0 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6 | use Test::More 'no_plan'; |
7 | |
8 | { |
9 | package My::SimpleTrait; |
10 | |
11 | use Moose::Role; |
12 | |
13 | sub simple { return 5 } |
14 | } |
15 | |
16 | { |
17 | package Foo; |
18 | |
19 | use Moose -traits => [ 'My::SimpleTrait' ]; |
20 | } |
21 | |
22 | can_ok( Foo->meta(), 'simple' ); |
23 | is( Foo->meta()->simple(), 5, |
24 | 'Foo->meta()->simple() returns expected value' ); |
25 | |
26 | { |
27 | package My::SimpleTrait2; |
28 | |
29 | use Moose::Role; |
30 | |
31 | # This needs to happen at compile time so it happens before we |
32 | # apply traits to Bar |
33 | BEGIN { |
34 | has 'attr' => |
35 | ( is => 'ro', |
36 | default => 'something', |
37 | ); |
38 | } |
39 | |
40 | sub simple { return 5 } |
41 | } |
42 | |
43 | { |
44 | package Bar; |
45 | |
46 | use Moose -traits => [ 'My::SimpleTrait2' ]; |
47 | } |
48 | |
49 | can_ok( Bar->meta(), 'simple' ); |
50 | is( Bar->meta()->simple(), 5, |
51 | 'Bar->meta()->simple() returns expected value' ); |
52 | can_ok( Bar->meta(), 'attr' ); |
53 | is( Bar->meta()->attr(), 'something', |
54 | 'Bar->meta()->attr() returns expected value' ); |
55 | |
56 | { |
57 | package My::SimpleTrait3; |
58 | |
59 | use Moose::Role; |
60 | |
61 | BEGIN { |
62 | has 'attr2' => |
63 | ( is => 'ro', |
64 | default => 'something', |
65 | ); |
66 | } |
67 | |
68 | sub simple2 { return 55 } |
69 | } |
70 | |
71 | { |
72 | package Baz; |
73 | |
74 | use Moose -traits => [ 'My::SimpleTrait2', 'My::SimpleTrait3' ]; |
75 | } |
76 | |
77 | can_ok( Baz->meta(), 'simple' ); |
78 | is( Baz->meta()->simple(), 5, |
79 | 'Baz->meta()->simple() returns expected value' ); |
80 | can_ok( Baz->meta(), 'attr' ); |
81 | is( Baz->meta()->attr(), 'something', |
82 | 'Baz->meta()->attr() returns expected value' ); |
83 | can_ok( Baz->meta(), 'simple2' ); |
84 | is( Baz->meta()->simple2(), 55, |
85 | 'Baz->meta()->simple2() returns expected value' ); |
86 | can_ok( Baz->meta(), 'attr2' ); |
87 | is( Baz->meta()->attr2(), 'something', |
88 | 'Baz->meta()->attr2() returns expected value' ); |
89 | |
90 | { |
91 | package My::Trait::AlwaysRO; |
92 | |
93 | use Moose::Role; |
94 | |
95 | around '_process_new_attribute', '_process_inherited_attribute' => |
96 | sub { |
97 | my $orig = shift; |
98 | my ( $self, $name, %args ) = @_; |
99 | |
100 | $args{is} = 'ro'; |
101 | |
102 | return $self->$orig( $name, %args ); |
103 | }; |
104 | } |
105 | |
106 | { |
107 | package Quux; |
108 | |
109 | use Moose -traits => [ 'My::Trait::AlwaysRO' ]; |
110 | |
111 | has 'size' => |
112 | ( is => 'rw', |
113 | isa => 'Int', |
114 | ); |
115 | } |
116 | |
117 | ok( Quux->meta()->has_attribute('size'), |
118 | 'Quux has size attribute' ); |
119 | ok( ! Quux->meta()->get_attribute('size')->writer(), |
120 | 'size attribute does not have a writer' ); |
121 | |
122 | { |
123 | package My::Class::Whatever; |
124 | |
125 | use Moose::Role; |
126 | |
127 | sub whatever { 42 } |
128 | |
129 | package Moose::Meta::Class::Custom::Trait::Whatever; |
130 | |
131 | sub register_implementation { |
132 | return 'My::Class::Whatever'; |
133 | } |
134 | } |
135 | |
136 | { |
137 | package RanOutOfNames; |
138 | |
139 | use Moose -traits => [ 'Whatever' ]; |
140 | } |
141 | |
142 | ok( RanOutOfNames->meta()->meta()->has_method('whatever'), |
143 | 'RanOutOfNames->meta() has whatever method' ); |
144 | |
145 | { |
146 | package Role::Foo; |
147 | |
148 | use Moose::Role -traits => [ 'My::SimpleTrait' ]; |
149 | } |
150 | |
151 | can_ok( Role::Foo->meta(), 'simple' ); |
152 | is( Role::Foo->meta()->simple(), 5, |
153 | 'Role::Foo->meta()->simple() returns expected value' ); |