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