10 use Moose::Util::TypeConstraints;
11 use List::Util qw( sum );
13 subtype 'H1', as 'HashRef[Int]';
14 subtype 'H2', as 'HashRef', where { scalar keys %{$_} < 2 };
15 subtype 'H3', as 'HashRef[Int]',
16 where { ( sum( values %{$_} ) || 0 ) < 5 };
18 subtype 'H5', as 'HashRef';
19 coerce 'H5', from 'Str', via { { key => $_ } };
21 no Moose::Util::TypeConstraints;
32 isa => 'HashRef[Int]',
34 set_hash_int => 'set',
71 clearer => '_clear_h4',
74 accessor_h4 => 'accessor',
85 clearer => '_clear_h5',
88 accessor_h5 => 'accessor',
97 is_deeply( $foo->hash_int, {}, "hash_int - correct contents" );
99 isnt( exception { $foo->set_hash_int( x => 'foo' ) }, undef, "hash_int - can't set wrong type" );
100 is_deeply( $foo->hash_int, {}, "hash_int - correct contents" );
102 $foo->set_hash_int( x => 1 );
103 is_deeply( $foo->hash_int, { x => 1 }, "hash_int - correct contents" );
107 isnt( exception { $foo->set_h1('foo') }, undef, "h1 - can't set onto undef" );
110 is_deeply( $foo->h1, {}, "h1 - correct contents" );
112 isnt( exception { $foo->set_h1( x => 'foo' ) }, undef, "h1 - can't set wrong type" );
114 is_deeply( $foo->h1, {}, "h1 - correct contents" );
116 $foo->set_h1( x => 1 );
117 is_deeply( $foo->h1, { x => 1 }, "h1 - correct contents" );
121 isnt( exception { $foo->set_h2('foo') }, undef, "h2 - can't set onto undef" );
124 is_deeply( $foo->h2, {}, "h2 - correct contents" );
126 $foo->set_h2( x => 'foo' );
127 is_deeply( $foo->h2, { x => 'foo' }, "h2 - correct contents" );
129 isnt( exception { $foo->set_h2( y => 'bar' ) }, undef, "h2 - can't set more than one element" );
131 is_deeply( $foo->h2, { x => 'foo' }, "h2 - correct contents" );
135 isnt( exception { $foo->set_h3(1) }, undef, "h3 - can't set onto undef" );
138 is_deeply( $foo->h3, {}, "h3 - correct contents" );
140 isnt( exception { $foo->set_h3( x => 'foo' ) }, undef, "h3 - can't set non-int" );
142 isnt( exception { $foo->set_h3( x => 100 ) }, undef, "h3 - can't violate overall type constraint" );
144 is_deeply( $foo->h3, {}, "h3 - correct contents" );
146 $foo->set_h3( x => 1 );
147 is_deeply( $foo->h3, { x => 1 }, "h3 - correct contents" );
149 isnt( exception { $foo->set_h3( x => 100 ) }, undef, "h3 - can't violate overall type constraint" );
151 is_deeply( $foo->h3, { x => 1 }, "h3 - correct contents" );
153 $foo->set_h3( y => 3 );
154 is_deeply( $foo->h3, { x => 1, y => 3 }, "h3 - correct contents" );
159 = qr/\QAttribute (h4) does not pass the type constraint because: Validation failed for 'HashRef' with value \E.*invalid.*/;
162 exception { $foo->accessor_h4('key'); },
164 'invalid default is caught when trying to read via accessor'
168 exception { $foo->accessor_h4( size => 42 ); },
170 'invalid default is caught when trying to write via accessor'
174 exception { $foo->get_h4(42); },
176 'invalid default is caught when trying to get'
184 $foo->accessor_h5('key'), 'invalid',
185 'lazy default is coerced when trying to read via accessor'
190 $foo->accessor_h5( size => 42 );
194 { key => 'invalid', size => 42 },
195 'lazy default is coerced when trying to write via accessor'
201 $foo->get_h5('key'), 'invalid',
202 'lazy default is coerced when trying to get'