Commit | Line | Data |
ad1917d7 |
1 | use strict; |
2 | use warnings; |
3 | |
fc553705 |
4 | use Test::More; |
dfab7c8b |
5 | use Test::Fatal; |
fc553705 |
6 | use if $ENV{AUTHOR_TESTING}, 'Test::Warnings'; |
ad1917d7 |
7 | |
8 | { |
9 | package MyClass; |
10 | use Moose; |
ad1917d7 |
11 | use MooseX::AlwaysCoerce; |
12 | use Moose::Util::TypeConstraints; |
13 | |
14 | subtype 'MyType', as 'Int'; |
15 | coerce 'MyType', from 'Str', via { length $_ }; |
16 | |
6b46d35c |
17 | subtype 'Uncoerced', as 'Int'; |
18 | |
ad1917d7 |
19 | has foo => (is => 'rw', isa => 'MyType'); |
20 | |
21 | class_has bar => (is => 'rw', isa => 'MyType'); |
44b44091 |
22 | |
23 | class_has baz => (is => 'rw', isa => 'MyType', coerce => 0); |
f327aa7a |
24 | |
25 | has quux => (is => 'rw', isa => 'MyType', coerce => 0); |
6b46d35c |
26 | |
27 | has uncoerced_attr => (is => 'rw', isa => 'Uncoerced'); |
28 | |
29 | class_has uncoerced_class_attr => (is => 'rw', isa => 'Uncoerced'); |
57d1fb14 |
30 | |
bb7cca58 |
31 | has untyped_attr => (is => 'rw'); |
32 | |
57d1fb14 |
33 | class_has untyped_class_attr => (is => 'rw'); |
ad1917d7 |
34 | } |
35 | |
36 | ok( (my $instance = MyClass->new), 'instance' ); |
37 | |
dfab7c8b |
38 | is( |
39 | exception { |
40 | $instance->foo('bar'); |
41 | is $instance->foo, 3; |
42 | }, |
43 | undef, |
44 | 'attribute coercion ran', |
45 | ); |
46 | |
47 | is( |
48 | exception { |
49 | $instance->bar('baz'); |
50 | is $instance->bar, 3; |
51 | }, |
52 | undef, |
53 | 'class attribute coercion ran', |
54 | ); |
55 | |
56 | isnt( |
57 | exception { $instance->baz('quux') }, |
58 | undef, |
59 | 'class attribute coercion did not run with coerce => 0', |
60 | ); |
61 | |
62 | isnt( |
63 | exception{ $instance->quux('mtfnpy') }, |
64 | undef, |
65 | 'attribute coercion did not run with coerce => 0', |
66 | ); |
67 | |
68 | is( |
69 | exception { |
70 | $instance->uncoerced_attr(10); |
71 | is $instance->uncoerced_attr(10), 10; |
72 | }, |
73 | undef, |
74 | 'set attribute having type with no coercion and no coerce=0', |
75 | ); |
76 | |
77 | is( |
78 | exception { |
79 | $instance->uncoerced_class_attr(10); |
80 | is $instance->uncoerced_class_attr(10), 10; |
81 | }, |
82 | undef, |
83 | 'set class attribute having type with no coercion and no coerce=0', |
84 | ); |
85 | |
86 | is( |
87 | exception { |
88 | $instance->untyped_attr(10); |
89 | is $instance->untyped_attr, 10; |
90 | }, |
91 | undef, |
92 | 'set untyped attribute', |
93 | ); |
94 | |
95 | is( |
96 | exception { |
97 | $instance->untyped_class_attr(10); |
98 | is $instance->untyped_class_attr, 10; |
99 | }, |
100 | undef, |
101 | 'set untyped class attribute', |
102 | ); |
fc553705 |
103 | |
104 | done_testing; |