Commit | Line | Data |
8d62bf6d |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
7ff56534 |
6 | use Test::More tests => 27; |
8d62bf6d |
7 | use Test::Exception; |
8 | |
7ff56534 |
9 | |
8d62bf6d |
10 | |
11 | =pod |
12 | |
d03bd989 |
13 | This basically just makes sure that using +name |
dd14f8e8 |
14 | on role attributes works right. |
8d62bf6d |
15 | |
16 | =cut |
17 | |
18 | { |
19 | package Foo::Role; |
20 | use Moose::Role; |
d03bd989 |
21 | |
8d62bf6d |
22 | has 'bar' => ( |
23 | is => 'rw', |
d03bd989 |
24 | isa => 'Int', |
8d62bf6d |
25 | default => sub { 10 }, |
26 | ); |
d03bd989 |
27 | |
8d62bf6d |
28 | package Foo; |
29 | use Moose; |
d03bd989 |
30 | |
8d62bf6d |
31 | with 'Foo::Role'; |
d03bd989 |
32 | |
8d62bf6d |
33 | ::lives_ok { |
34 | has '+bar' => (default => sub { 100 }); |
d03bd989 |
35 | } '... extended the attribute successfully'; |
8d62bf6d |
36 | } |
37 | |
38 | my $foo = Foo->new; |
39 | isa_ok($foo, 'Foo'); |
40 | |
41 | is($foo->bar, 100, '... got the extended attribute'); |
42 | |
b7835731 |
43 | |
dd14f8e8 |
44 | { |
45 | package Bar::Role; |
46 | use Moose::Role; |
47 | |
48 | has 'foo' => ( |
49 | is => 'rw', |
50 | isa => 'Str | Int', |
51 | ); |
52 | |
53 | package Bar; |
54 | use Moose; |
55 | |
56 | with 'Bar::Role'; |
57 | |
58 | ::lives_ok { |
59 | has '+foo' => ( |
60 | isa => 'Int', |
61 | ) |
62 | } "... narrowed the role's type constraint successfully"; |
63 | } |
64 | |
dd14f8e8 |
65 | my $bar = Bar->new(foo => 42); |
66 | isa_ok($bar, 'Bar'); |
67 | is($bar->foo, 42, '... got the extended attribute'); |
68 | $bar->foo(100); |
69 | is($bar->foo, 100, "... can change the attribute's value to an Int"); |
70 | |
71 | throws_ok { $bar->foo("baz") } qr/^Attribute \(foo\) does not pass the type constraint because: Validation failed for 'Int' failed with value baz at /; |
72 | is($bar->foo, 100, "... still has the old Int value"); |
73 | |
b7835731 |
74 | |
68e9fbfc |
75 | { |
76 | package Baz::Role; |
77 | use Moose::Role; |
78 | |
79 | has 'baz' => ( |
80 | is => 'rw', |
b7835731 |
81 | isa => 'Value', |
68e9fbfc |
82 | ); |
83 | |
84 | package Baz; |
85 | use Moose; |
86 | |
87 | with 'Baz::Role'; |
88 | |
89 | ::lives_ok { |
90 | has '+baz' => ( |
b7835731 |
91 | isa => 'Int | ClassName', |
68e9fbfc |
92 | ) |
93 | } "... narrowed the role's type constraint successfully"; |
94 | } |
95 | |
68e9fbfc |
96 | my $baz = Baz->new(baz => 99); |
97 | isa_ok($baz, 'Baz'); |
98 | is($baz->baz, 99, '... got the extended attribute'); |
b7835731 |
99 | $baz->baz('Foo'); |
100 | is($baz->baz, 'Foo', "... can change the attribute's value to a ClassName"); |
101 | |
eb4c4e82 |
102 | throws_ok { $baz->baz("zonk") } qr/^Attribute \(baz\) does not pass the type constraint because: Validation failed for 'ClassName\|Int' failed with value zonk at /; |
b7835731 |
103 | is_deeply($baz->baz, 'Foo', "... still has the old ClassName value"); |
68e9fbfc |
104 | |
68e9fbfc |
105 | |
657f212a |
106 | { |
107 | package Quux::Role; |
108 | use Moose::Role; |
109 | |
110 | has 'quux' => ( |
111 | is => 'rw', |
112 | isa => 'Str | Int | Ref', |
113 | ); |
114 | |
115 | package Quux; |
116 | use Moose; |
117 | use Moose::Util::TypeConstraints; |
118 | |
119 | with 'Quux::Role'; |
120 | |
121 | subtype 'Positive' |
122 | => as 'Int' |
123 | => where { $_ > 0 }; |
124 | |
125 | ::lives_ok { |
126 | has '+quux' => ( |
127 | isa => 'Positive | ArrayRef', |
128 | ) |
129 | } "... narrowed the role's type constraint successfully"; |
130 | } |
131 | |
657f212a |
132 | my $quux = Quux->new(quux => 99); |
133 | isa_ok($quux, 'Quux'); |
134 | is($quux->quux, 99, '... got the extended attribute'); |
135 | $quux->quux(100); |
136 | is($quux->quux, 100, "... can change the attribute's value to an Int"); |
137 | $quux->quux(["hi"]); |
138 | is_deeply($quux->quux, ["hi"], "... can change the attribute's value to an ArrayRef"); |
139 | |
eb4c4e82 |
140 | throws_ok { $quux->quux("quux") } qr/^Attribute \(quux\) does not pass the type constraint because: Validation failed for 'ArrayRef\|Positive' failed with value quux at /; |
657f212a |
141 | is_deeply($quux->quux, ["hi"], "... still has the old ArrayRef value"); |
142 | |
eb4c4e82 |
143 | throws_ok { $quux->quux({a => 1}) } qr/^Attribute \(quux\) does not pass the type constraint because: Validation failed for 'ArrayRef\|Positive' failed with value HASH\(\w+\) at /; |
657f212a |
144 | is_deeply($quux->quux, ["hi"], "... still has the old ArrayRef value"); |
145 | |
b7835731 |
146 | |
657f212a |
147 | { |
148 | package Err::Role; |
149 | use Moose::Role; |
150 | |
5e98d2b6 |
151 | for (1..3) { |
152 | has "err$_" => ( |
153 | isa => 'Str | Int', |
ccd4cff9 |
154 | is => 'bare', |
5e98d2b6 |
155 | ); |
156 | } |
657f212a |
157 | |
158 | package Err; |
159 | use Moose; |
160 | |
161 | with 'Err::Role'; |
162 | |
5e98d2b6 |
163 | ::lives_ok { |
164 | has '+err1' => (isa => 'Defined'); |
165 | } "can get less specific in the subclass"; |
657f212a |
166 | |
5e98d2b6 |
167 | ::lives_ok { |
168 | has '+err2' => (isa => 'Bool'); |
169 | } "or change the type completely"; |
657f212a |
170 | |
5e98d2b6 |
171 | ::lives_ok { |
172 | has '+err3' => (isa => 'Str | ArrayRef'); |
173 | } "or add new types to the union"; |
657f212a |
174 | } |
175 | |