remove unneeded use of Test::Fatal
[gitmo/Moose.git] / t / 070_native_traits / 053_hash_coerce.t
CommitLineData
a9c1f4ec 1use strict;
2use warnings;
3
4use 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
48my $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
76done_testing;