Commit | Line | Data |
a9c1f4ec |
1 | use strict; |
2 | use warnings; |
3 | |
4 | use Test::More; |
5 | use Test::Exception; |
6 | |
7 | { |
8 | |
9 | package Foo; |
10 | use Moose; |
11 | use Moose::Util::TypeConstraints; |
12 | |
13 | subtype 'UCHash', as 'HashRef[Str]', where { |
14 | !grep {/[a-z]/} values %{$_}; |
15 | }; |
16 | |
17 | coerce 'UCHash', from 'HashRef[Str]', via { |
18 | $_ = uc $_ for values %{$_}; |
19 | $_; |
20 | }; |
21 | |
22 | has hash => ( |
23 | traits => ['Hash'], |
24 | is => 'rw', |
25 | isa => 'UCHash', |
26 | coerce => 1, |
27 | handles => { |
28 | set_key => 'set', |
29 | }, |
30 | ); |
31 | |
32 | our @TriggerArgs; |
33 | |
34 | has lazy => ( |
35 | traits => ['Hash'], |
36 | is => 'rw', |
37 | isa => 'UCHash', |
38 | coerce => 1, |
39 | lazy => 1, |
40 | default => sub { { x => 'a' } }, |
41 | handles => { |
42 | set_lazy => 'set', |
43 | }, |
44 | trigger => sub { @TriggerArgs = @_ }, |
45 | clearer => 'clear_lazy', |
46 | ); |
47 | } |
48 | |
49 | my $foo = Foo->new; |
50 | |
51 | { |
52 | $foo->hash( { x => 'A', y => 'B' } ); |
53 | |
54 | $foo->set_key( z => 'c' ); |
55 | |
56 | is_deeply( |
57 | $foo->hash, { x => 'A', y => 'B', z => 'C' }, |
58 | 'set coerces the hash' |
59 | ); |
60 | } |
61 | |
62 | { |
63 | $foo->set_lazy( y => 'b' ); |
64 | |
65 | is_deeply( |
66 | $foo->lazy, { x => 'A', y => 'B' }, |
67 | 'set coerces the hash - lazy' |
68 | ); |
69 | |
70 | is_deeply( |
71 | \@Foo::TriggerArgs, |
72 | [ $foo, { x => 'A', y => 'B' }, { x => 'A' } ], |
73 | 'trigger receives expected arguments' |
74 | ); |
75 | } |
76 | |
77 | done_testing; |