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 | |
76 | done_testing; |