Commit | Line | Data |
06d16be0 |
1 | #!/usr/bin/env perl |
2 | use strict; |
3 | use warnings; |
4 | use Test::More; |
b10dde3a |
5 | use Test::Fatal; |
06d16be0 |
6 | |
7 | { |
8 | use Moose::Util::TypeConstraints; |
9 | use List::Util qw(sum); |
10 | |
11 | subtype 'A1', as 'ArrayRef[Int]'; |
ee588adf |
12 | subtype 'A2', as 'ArrayRef', where { @$_ < 2 }; |
435e394d |
13 | subtype 'A3', as 'ArrayRef[Int]', where { ( sum(@$_) || 0 ) < 5 }; |
06d16be0 |
14 | |
15 | no Moose::Util::TypeConstraints; |
16 | } |
17 | |
18 | { |
19 | package Foo; |
20 | use Moose; |
21 | |
22 | has array => ( |
23 | traits => ['Array'], |
24 | is => 'rw', |
25 | isa => 'ArrayRef', |
26 | handles => { |
27 | push_array => 'push', |
28 | }, |
29 | ); |
30 | has array_int => ( |
31 | traits => ['Array'], |
32 | is => 'rw', |
33 | isa => 'ArrayRef[Int]', |
34 | handles => { |
35 | push_array_int => 'push', |
36 | }, |
37 | ); |
38 | has a1 => ( |
39 | traits => ['Array'], |
40 | is => 'rw', |
41 | isa => 'A1', |
42 | handles => { |
43 | push_a1 => 'push', |
44 | }, |
45 | ); |
46 | has a2 => ( |
47 | traits => ['Array'], |
48 | is => 'rw', |
49 | isa => 'A2', |
50 | handles => { |
51 | push_a2 => 'push', |
52 | }, |
53 | ); |
54 | has a3 => ( |
55 | traits => ['Array'], |
56 | is => 'rw', |
57 | isa => 'A3', |
58 | handles => { |
59 | push_a3 => 'push', |
60 | }, |
61 | ); |
62 | } |
63 | |
64 | my $foo = Foo->new; |
65 | |
66 | { |
ee588adf |
67 | $foo->array( [] ); |
68 | is_deeply( $foo->array, [], "array - correct contents" ); |
06d16be0 |
69 | |
70 | $foo->push_array('foo'); |
ee588adf |
71 | is_deeply( $foo->array, ['foo'], "array - correct contents" ); |
06d16be0 |
72 | } |
73 | |
74 | { |
ee588adf |
75 | $foo->array_int( [] ); |
76 | is_deeply( $foo->array_int, [], "array_int - correct contents" ); |
06d16be0 |
77 | |
b10dde3a |
78 | isnt( exception { $foo->push_array_int('foo') }, undef, "array_int - can't push wrong type" ); |
ee588adf |
79 | is_deeply( $foo->array_int, [], "array_int - correct contents" ); |
06d16be0 |
80 | |
81 | $foo->push_array_int(1); |
ee588adf |
82 | is_deeply( $foo->array_int, [1], "array_int - correct contents" ); |
06d16be0 |
83 | } |
84 | |
85 | { |
b10dde3a |
86 | isnt( exception { $foo->push_a1('foo') }, undef, "a1 - can't push onto undef" ); |
ee588adf |
87 | |
88 | $foo->a1( [] ); |
89 | is_deeply( $foo->a1, [], "a1 - correct contents" ); |
90 | |
b10dde3a |
91 | isnt( exception { $foo->push_a1('foo') }, undef, "a1 - can't push wrong type" ); |
ee588adf |
92 | |
93 | is_deeply( $foo->a1, [], "a1 - correct contents" ); |
06d16be0 |
94 | |
95 | $foo->push_a1(1); |
ee588adf |
96 | is_deeply( $foo->a1, [1], "a1 - correct contents" ); |
06d16be0 |
97 | } |
98 | |
99 | { |
b10dde3a |
100 | isnt( exception { $foo->push_a2('foo') }, undef, "a2 - can't push onto undef" ); |
06d16be0 |
101 | |
ee588adf |
102 | $foo->a2( [] ); |
103 | is_deeply( $foo->a2, [], "a2 - correct contents" ); |
06d16be0 |
104 | |
105 | $foo->push_a2('foo'); |
ee588adf |
106 | is_deeply( $foo->a2, ['foo'], "a2 - correct contents" ); |
107 | |
b10dde3a |
108 | isnt( exception { $foo->push_a2('bar') }, undef, "a2 - can't push more than one element" ); |
ee588adf |
109 | |
110 | is_deeply( $foo->a2, ['foo'], "a2 - correct contents" ); |
06d16be0 |
111 | } |
112 | |
113 | { |
b10dde3a |
114 | isnt( exception { $foo->push_a3(1) }, undef, "a3 - can't push onto undef" ); |
ee588adf |
115 | |
116 | $foo->a3( [] ); |
117 | is_deeply( $foo->a3, [], "a3 - correct contents" ); |
118 | |
b10dde3a |
119 | isnt( exception { $foo->push_a3('foo') }, undef, "a3 - can't push non-int" ); |
ee588adf |
120 | |
b10dde3a |
121 | isnt( exception { $foo->push_a3(100) }, undef, "a3 - can't violate overall type constraint" ); |
ee588adf |
122 | |
123 | is_deeply( $foo->a3, [], "a3 - correct contents" ); |
06d16be0 |
124 | |
125 | $foo->push_a3(1); |
ee588adf |
126 | is_deeply( $foo->a3, [1], "a3 - correct contents" ); |
127 | |
b10dde3a |
128 | isnt( exception { $foo->push_a3(100) }, undef, "a3 - can't violate overall type constraint" ); |
ee588adf |
129 | |
130 | is_deeply( $foo->a3, [1], "a3 - correct contents" ); |
06d16be0 |
131 | |
132 | $foo->push_a3(3); |
ee588adf |
133 | is_deeply( $foo->a3, [ 1, 3 ], "a3 - correct contents" ); |
06d16be0 |
134 | } |
135 | |
136 | done_testing; |