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