Commit | Line | Data |
29dcbf33 |
1 | #!/usr/bin/env perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6 | use Test::More; |
b10dde3a |
7 | use Test::Fatal; |
29dcbf33 |
8 | |
9 | { |
10 | use Moose::Util::TypeConstraints; |
11 | use List::Util qw( sum ); |
12 | |
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 }; |
17 | |
18 | no Moose::Util::TypeConstraints; |
19 | } |
20 | |
21 | { |
22 | |
23 | package Foo; |
24 | use Moose; |
25 | |
26 | has hash_int => ( |
27 | traits => ['Hash'], |
28 | is => 'rw', |
29 | isa => 'HashRef[Int]', |
30 | handles => { |
31 | set_hash_int => 'set', |
32 | }, |
33 | ); |
34 | |
35 | has h1 => ( |
36 | traits => ['Hash'], |
37 | is => 'rw', |
38 | isa => 'H1', |
39 | handles => { |
40 | set_h1 => 'set', |
41 | }, |
42 | ); |
43 | |
44 | has h2 => ( |
45 | traits => ['Hash'], |
46 | is => 'rw', |
47 | isa => 'H2', |
48 | handles => { |
49 | set_h2 => 'set', |
50 | }, |
51 | ); |
52 | |
53 | has h3 => ( |
54 | traits => ['Hash'], |
55 | is => 'rw', |
56 | isa => 'H3', |
57 | handles => { |
58 | set_h3 => 'set', |
59 | }, |
60 | ); |
61 | } |
62 | |
63 | my $foo = Foo->new; |
64 | |
65 | { |
66 | $foo->hash_int( {} ); |
67 | is_deeply( $foo->hash_int, {}, "hash_int - correct contents" ); |
68 | |
b10dde3a |
69 | isnt( exception { $foo->set_hash_int( x => 'foo' ) }, undef, "hash_int - can't set wrong type" ); |
29dcbf33 |
70 | is_deeply( $foo->hash_int, {}, "hash_int - correct contents" ); |
71 | |
72 | $foo->set_hash_int( x => 1 ); |
73 | is_deeply( $foo->hash_int, { x => 1 }, "hash_int - correct contents" ); |
74 | } |
75 | |
76 | { |
b10dde3a |
77 | isnt( exception { $foo->set_h1('foo') }, undef, "h1 - can't set onto undef" ); |
29dcbf33 |
78 | |
79 | $foo->h1( {} ); |
80 | is_deeply( $foo->h1, {}, "h1 - correct contents" ); |
81 | |
b10dde3a |
82 | isnt( exception { $foo->set_h1( x => 'foo' ) }, undef, "h1 - can't set wrong type" ); |
29dcbf33 |
83 | |
84 | is_deeply( $foo->h1, {}, "h1 - correct contents" ); |
85 | |
86 | $foo->set_h1( x => 1 ); |
87 | is_deeply( $foo->h1, { x => 1 }, "h1 - correct contents" ); |
88 | } |
89 | |
90 | { |
b10dde3a |
91 | isnt( exception { $foo->set_h2('foo') }, undef, "h2 - can't set onto undef" ); |
29dcbf33 |
92 | |
93 | $foo->h2( {} ); |
94 | is_deeply( $foo->h2, {}, "h2 - correct contents" ); |
95 | |
96 | $foo->set_h2( x => 'foo' ); |
97 | is_deeply( $foo->h2, { x => 'foo' }, "h2 - correct contents" ); |
98 | |
b10dde3a |
99 | isnt( exception { $foo->set_h2( y => 'bar' ) }, undef, "h2 - can't set more than one element" ); |
29dcbf33 |
100 | |
101 | is_deeply( $foo->h2, { x => 'foo' }, "h2 - correct contents" ); |
102 | } |
103 | |
104 | { |
b10dde3a |
105 | isnt( exception { $foo->set_h3(1) }, undef, "h3 - can't set onto undef" ); |
29dcbf33 |
106 | |
107 | $foo->h3( {} ); |
108 | is_deeply( $foo->h3, {}, "h3 - correct contents" ); |
109 | |
b10dde3a |
110 | isnt( exception { $foo->set_h3( x => 'foo' ) }, undef, "h3 - can't set non-int" ); |
29dcbf33 |
111 | |
b10dde3a |
112 | isnt( exception { $foo->set_h3( x => 100 ) }, undef, "h3 - can't violate overall type constraint" ); |
29dcbf33 |
113 | |
114 | is_deeply( $foo->h3, {}, "h3 - correct contents" ); |
115 | |
116 | $foo->set_h3( x => 1 ); |
117 | is_deeply( $foo->h3, { x => 1 }, "h3 - correct contents" ); |
118 | |
b10dde3a |
119 | isnt( exception { $foo->set_h3( x => 100 ) }, undef, "h3 - can't violate overall type constraint" ); |
29dcbf33 |
120 | |
121 | is_deeply( $foo->h3, { x => 1 }, "h3 - correct contents" ); |
122 | |
123 | $foo->set_h3( y => 3 ); |
124 | is_deeply( $foo->h3, { x => 1, y => 3 }, "h3 - correct contents" ); |
125 | } |
126 | |
127 | done_testing; |