Commit | Line | Data |
a30fa891 |
1 | use strict; |
2 | use warnings; |
3 | |
4 | use Test::More tests=>14; |
5 | |
6 | use_ok 'MooseX::Meta::TypeConstraint::Structured'; |
7 | use_ok 'Moose::Util::TypeConstraints'; |
8 | |
9 | ok my $int = find_type_constraint('Int') => 'Got Int'; |
10 | ok my $str = find_type_constraint('Str') => 'Got Str'; |
11 | ok my $arrayref = find_type_constraint('ArrayRef') => 'Got ArrayRef'; |
12 | |
13 | my $list_tc = MooseX::Meta::TypeConstraint::Structured->new( |
14 | name => 'list_tc', |
15 | parent => $arrayref, |
16 | type_constraints => [$int, $str], |
17 | constraint_generator=> sub { |
a4ae4800 |
18 | my ($self) = @_; |
19 | my @type_constraints = @{ $self->type_constraints }; |
20 | |
21 | return sub { |
22 | my ($values, $err) = @_; |
23 | my @values = @$values; |
24 | |
25 | for my $type_constraint (@type_constraints) { |
26 | my $value = shift @values || return; |
27 | $type_constraint->check($value) || return; |
28 | } |
29 | if(@values) { |
30 | return; |
31 | } else { |
32 | return 1; |
33 | } |
a30fa891 |
34 | } |
35 | } |
36 | ); |
37 | |
38 | isa_ok $list_tc, 'MooseX::Meta::TypeConstraint::Structured'; |
39 | |
40 | ok !$arrayref->check() => 'Parent undef fails'; |
41 | ok !$list_tc->check() => 'undef fails'; |
42 | ok !$list_tc->check(1) => '1 fails'; |
43 | ok !$list_tc->check([]) => '[] fails'; |
44 | ok !$list_tc->check([1]) => '[1] fails'; |
45 | ok !$list_tc->check([1,2,3]) => '[1,2,3] fails'; |
46 | ok !$list_tc->check(['a','b']) => '["a","b"] fails'; |
47 | |
48 | ok $list_tc->check([1,'a']) => '[1,"a"] passes'; |