Test coercion of lazy defaults
[gitmo/Moose.git] / t / 070_native_traits / 011_array_subtypes.t
CommitLineData
06d16be0 1#!/usr/bin/env perl
2use strict;
3use warnings;
4use Test::More;
b10dde3a 5use 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
603454da 15 subtype 'A5', as 'ArrayRef';
16 coerce 'A5', from 'Str', via { [ $_ ] };
17
06d16be0 18 no Moose::Util::TypeConstraints;
19}
20
21{
22 package Foo;
23 use Moose;
24
25 has array => (
26 traits => ['Array'],
27 is => 'rw',
28 isa => 'ArrayRef',
29 handles => {
30 push_array => 'push',
31 },
32 );
33 has array_int => (
34 traits => ['Array'],
35 is => 'rw',
36 isa => 'ArrayRef[Int]',
37 handles => {
38 push_array_int => 'push',
39 },
40 );
41 has a1 => (
42 traits => ['Array'],
43 is => 'rw',
44 isa => 'A1',
45 handles => {
46 push_a1 => 'push',
47 },
48 );
49 has a2 => (
50 traits => ['Array'],
51 is => 'rw',
52 isa => 'A2',
53 handles => {
54 push_a2 => 'push',
55 },
56 );
57 has a3 => (
58 traits => ['Array'],
59 is => 'rw',
60 isa => 'A3',
61 handles => {
62 push_a3 => 'push',
63 },
64 );
7a431e9c 65 has a4 => (
66 traits => ['Array'],
67 is => 'rw',
68 isa => 'ArrayRef',
69 lazy => 1,
70 default => 'invalid',
71 clearer => '_clear_a4',
72 handles => {
603454da 73 get_a4 => 'get',
7a431e9c 74 push_a4 => 'push',
75 accessor_a4 => 'accessor',
76 },
77 );
603454da 78 has a5 => (
79 traits => ['Array'],
80 is => 'rw',
81 isa => 'A5',
82 coerce => 1,
83 lazy => 1,
84 default => 'invalid',
85 clearer => '_clear_a5',
86 handles => {
87 get_a5 => 'get',
88 push_a5 => 'push',
89 accessor_a5 => 'accessor',
90 },
91 );
06d16be0 92}
93
94my $foo = Foo->new;
95
96{
ee588adf 97 $foo->array( [] );
98 is_deeply( $foo->array, [], "array - correct contents" );
06d16be0 99
100 $foo->push_array('foo');
ee588adf 101 is_deeply( $foo->array, ['foo'], "array - correct contents" );
06d16be0 102}
103
104{
ee588adf 105 $foo->array_int( [] );
106 is_deeply( $foo->array_int, [], "array_int - correct contents" );
06d16be0 107
b10dde3a 108 isnt( exception { $foo->push_array_int('foo') }, undef, "array_int - can't push wrong type" );
ee588adf 109 is_deeply( $foo->array_int, [], "array_int - correct contents" );
06d16be0 110
111 $foo->push_array_int(1);
ee588adf 112 is_deeply( $foo->array_int, [1], "array_int - correct contents" );
06d16be0 113}
114
115{
b10dde3a 116 isnt( exception { $foo->push_a1('foo') }, undef, "a1 - can't push onto undef" );
ee588adf 117
118 $foo->a1( [] );
119 is_deeply( $foo->a1, [], "a1 - correct contents" );
120
b10dde3a 121 isnt( exception { $foo->push_a1('foo') }, undef, "a1 - can't push wrong type" );
ee588adf 122
123 is_deeply( $foo->a1, [], "a1 - correct contents" );
06d16be0 124
125 $foo->push_a1(1);
ee588adf 126 is_deeply( $foo->a1, [1], "a1 - correct contents" );
06d16be0 127}
128
129{
b10dde3a 130 isnt( exception { $foo->push_a2('foo') }, undef, "a2 - can't push onto undef" );
06d16be0 131
ee588adf 132 $foo->a2( [] );
133 is_deeply( $foo->a2, [], "a2 - correct contents" );
06d16be0 134
135 $foo->push_a2('foo');
ee588adf 136 is_deeply( $foo->a2, ['foo'], "a2 - correct contents" );
137
b10dde3a 138 isnt( exception { $foo->push_a2('bar') }, undef, "a2 - can't push more than one element" );
ee588adf 139
140 is_deeply( $foo->a2, ['foo'], "a2 - correct contents" );
06d16be0 141}
142
143{
b10dde3a 144 isnt( exception { $foo->push_a3(1) }, undef, "a3 - can't push onto undef" );
ee588adf 145
146 $foo->a3( [] );
147 is_deeply( $foo->a3, [], "a3 - correct contents" );
148
b10dde3a 149 isnt( exception { $foo->push_a3('foo') }, undef, "a3 - can't push non-int" );
ee588adf 150
b10dde3a 151 isnt( exception { $foo->push_a3(100) }, undef, "a3 - can't violate overall type constraint" );
ee588adf 152
153 is_deeply( $foo->a3, [], "a3 - correct contents" );
06d16be0 154
155 $foo->push_a3(1);
ee588adf 156 is_deeply( $foo->a3, [1], "a3 - correct contents" );
157
b10dde3a 158 isnt( exception { $foo->push_a3(100) }, undef, "a3 - can't violate overall type constraint" );
ee588adf 159
160 is_deeply( $foo->a3, [1], "a3 - correct contents" );
06d16be0 161
162 $foo->push_a3(3);
ee588adf 163 is_deeply( $foo->a3, [ 1, 3 ], "a3 - correct contents" );
06d16be0 164}
165
7a431e9c 166{
167 my $expect = qr/\QAttribute (a4) does not pass the type constraint because: Validation failed for 'ArrayRef' with value invalid/;
168
169 like(
170 exception { $foo->accessor_a4(0); },
171 $expect,
172 'invalid default is caught when trying to read via accessor'
173 );
174
175 like(
176 exception { $foo->accessor_a4(0 => 42); },
177 $expect,
178 'invalid default is caught when trying to write via accessor'
179 );
180
181 like(
182 exception { $foo->push_a4(42); },
183 $expect,
184 'invalid default is caught when trying to push'
185 );
186
187 like(
188 exception { $foo->get_a4(42); },
189 $expect,
190 'invalid default is caught when trying to get'
191 );
192}
193
603454da 194{
195 my $foo = Foo->new;
196
197 is(
198 $foo->accessor_a5(0), 'invalid',
199 'lazy default is coerced when trying to read via accessor'
200 );
201
202 $foo->_clear_a5;
203
204 $foo->accessor_a5( 1 => 'thing' );
205
206 is_deeply(
207 $foo->a5,
208 [ 'invalid', 'thing' ],
209 'lazy default is coerced when trying to write via accessor'
210 );
211
212 $foo->_clear_a5;
213
214 $foo->push_a5('thing');
215
216 is_deeply(
217 $foo->a5,
218 [ 'invalid', 'thing' ],
219 'lazy default is coerced when trying to push'
220 );
221
222 $foo->_clear_a5;
223
224 is(
225 $foo->get_a5(0), 'invalid',
226 'lazy default is coerced when trying to get'
227 );
228}
229
06d16be0 230done_testing;