Commit | Line | Data |
a9c1f4ec |
1 | use strict; |
2 | use warnings; |
3 | |
4 | use Test::More; |
a9c1f4ec |
5 | |
6 | { |
7 | |
8 | package Foo; |
9 | use Moose; |
10 | use Moose::Util::TypeConstraints; |
11 | |
12 | subtype 'UCHash', as 'HashRef[Str]', where { |
13 | !grep {/[a-z]/} values %{$_}; |
14 | }; |
15 | |
16 | coerce 'UCHash', from 'HashRef[Str]', via { |
17 | $_ = uc $_ for values %{$_}; |
18 | $_; |
19 | }; |
20 | |
21 | has hash => ( |
22 | traits => ['Hash'], |
23 | is => 'rw', |
24 | isa => 'UCHash', |
25 | coerce => 1, |
26 | handles => { |
27 | set_key => 'set', |
28 | }, |
29 | ); |
30 | |
31 | our @TriggerArgs; |
32 | |
33 | has lazy => ( |
34 | traits => ['Hash'], |
35 | is => 'rw', |
36 | isa => 'UCHash', |
37 | coerce => 1, |
38 | lazy => 1, |
39 | default => sub { { x => 'a' } }, |
40 | handles => { |
41 | set_lazy => 'set', |
42 | }, |
43 | trigger => sub { @TriggerArgs = @_ }, |
44 | clearer => 'clear_lazy', |
45 | ); |
46 | } |
47 | |
48 | my $foo = Foo->new; |
49 | |
50 | { |
51 | $foo->hash( { x => 'A', y => 'B' } ); |
52 | |
53 | $foo->set_key( z => 'c' ); |
54 | |
55 | is_deeply( |
56 | $foo->hash, { x => 'A', y => 'B', z => 'C' }, |
57 | 'set coerces the hash' |
58 | ); |
59 | } |
60 | |
61 | { |
62 | $foo->set_lazy( y => 'b' ); |
63 | |
64 | is_deeply( |
65 | $foo->lazy, { x => 'A', y => 'B' }, |
66 | 'set coerces the hash - lazy' |
67 | ); |
68 | |
69 | is_deeply( |
70 | \@Foo::TriggerArgs, |
71 | [ $foo, { x => 'A', y => 'B' }, { x => 'A' } ], |
72 | 'trigger receives expected arguments' |
73 | ); |
74 | } |
75 | |
aff87227 |
76 | { |
77 | package Thing; |
78 | use Moose; |
79 | |
80 | has thing => ( |
81 | is => 'ro', |
82 | isa => 'Str', |
83 | ); |
84 | } |
85 | |
86 | { |
87 | package Bar; |
88 | use Moose; |
89 | use Moose::Util::TypeConstraints; |
90 | |
91 | class_type 'Thing'; |
92 | |
93 | coerce 'Thing' |
94 | => from 'Str' |
95 | => via { Thing->new( thing => $_ ) }; |
96 | |
97 | subtype 'HashRefOfThings' |
98 | => as 'HashRef[Thing]'; |
99 | |
100 | coerce 'HashRefOfThings' |
101 | => from 'HashRef[Str]' |
102 | => via { |
103 | my %new; |
104 | for my $k ( keys %{$_} ) { |
105 | $new{$k} = Thing->new( thing => $_->{$k} ); |
106 | } |
107 | return \%new; |
108 | }; |
109 | |
110 | coerce 'HashRefOfThings' |
111 | => from 'Str' |
112 | => via { [ Thing->new( thing => $_ ) ] }; |
113 | |
114 | has hash => ( |
115 | traits => ['Hash'], |
116 | is => 'rw', |
117 | isa => 'HashRefOfThings', |
118 | coerce => 1, |
119 | handles => { |
120 | set_hash => 'set', |
121 | get_hash => 'get', |
122 | }, |
123 | ); |
124 | } |
125 | |
126 | { |
127 | my $bar = Bar->new( hash => { foo => 1, bar => 2 } ); |
128 | |
129 | is( |
130 | $bar->get_hash('foo')->thing, 1, |
131 | 'constructor coerces hash reference' |
132 | ); |
133 | |
134 | $bar->set_hash( baz => 3, quux => 4 ); |
135 | |
136 | is( |
137 | $bar->get_hash('baz')->thing, 3, |
138 | 'set coerces new hash values' |
139 | ); |
140 | |
141 | is( |
142 | $bar->get_hash('quux')->thing, 4, |
143 | 'set coerces new hash values' |
144 | ); |
145 | } |
146 | |
147 | |
a9c1f4ec |
148 | done_testing; |