Commit | Line | Data |
65748864 |
1 | BEGIN { |
2 | use strict; |
3 | use warnings; |
9a920d27 |
4 | use Test::More tests=>25; |
65748864 |
5 | use Test::Exception; |
6 | } |
7 | |
8 | { |
bc64165b |
9 | package Test::MooseX::Meta::TypeConstraint::Structured; |
65748864 |
10 | |
11 | use Moose; |
12 | use Moose::Util::TypeConstraints; |
13 | use MooseX::Meta::TypeConstraint::Structured; |
9a920d27 |
14 | |
c3abf064 |
15 | subtype 'MyString', |
16 | as 'Str', |
17 | where { $_=~m/abc/}; |
9a920d27 |
18 | |
65748864 |
19 | sub Tuple { |
bc64165b |
20 | my @args = @{shift @_}; |
65748864 |
21 | return MooseX::Meta::TypeConstraint::Structured->new( |
22 | name => 'Tuple', |
23 | parent => find_type_constraint('ArrayRef'), |
24 | package_defined_in => __PACKAGE__, |
8b276dd4 |
25 | signature => [map { |
9a920d27 |
26 | _normalize_type_constraint($_); |
8b276dd4 |
27 | } @args], |
bc64165b |
28 | ); |
29 | } |
9a920d27 |
30 | |
bc64165b |
31 | sub Dict { |
32 | my %args = @{shift @_}; |
33 | return MooseX::Meta::TypeConstraint::Structured->new( |
8b276dd4 |
34 | name => 'Dict', |
bc64165b |
35 | parent => find_type_constraint('HashRef'), |
36 | package_defined_in => __PACKAGE__, |
8b276dd4 |
37 | signature => {map { |
9a920d27 |
38 | $_ => _normalize_type_constraint($args{$_}); |
8b276dd4 |
39 | } keys %args}, |
65748864 |
40 | ); |
41 | } |
c3abf064 |
42 | |
9a920d27 |
43 | sub _normalize_type_constraint { |
44 | my $tc = shift @_; |
45 | if($tc && blessed $tc && $tc->isa('Moose::Meta::TypeConstraint')) { |
46 | return $tc; |
47 | } elsif($tc) { |
48 | return Moose::Util::TypeConstraints::find_or_parse_type_constraint($tc); |
49 | } |
50 | } |
51 | |
c3abf064 |
52 | has 'tuple' => (is=>'rw', isa=>Tuple['Int', 'Str', 'MyString']); |
bc64165b |
53 | has 'dict' => (is=>'rw', isa=>Dict[name=>'Str', age=>'Int']); |
8b276dd4 |
54 | has 'dict_with_maybe' => (is=>'rw', isa=>Dict[name=>'Str', age=>'Maybe[Int]']); |
55 | has 'tuple_with_param' => (is=>'rw', isa=>Tuple['Int', 'Str', 'ArrayRef[Int]']); |
56 | has 'tuple_with_maybe' => (is=>'rw', isa=>Tuple['Int', 'Str', 'Maybe[Int]']); |
9a920d27 |
57 | has 'dict_with_tuple' => (is=>'rw', isa=>Dict[key1=>'Str', key2=>Tuple['Int','Str']]); |
65748864 |
58 | } |
59 | |
60 | ## Instantiate a new test object |
61 | |
bc64165b |
62 | ok my $record = Test::MooseX::Meta::TypeConstraint::Structured->new |
65748864 |
63 | => 'Instantiated new Record test class.'; |
64 | |
bc64165b |
65 | isa_ok $record => 'Test::MooseX::Meta::TypeConstraint::Structured' |
65748864 |
66 | => 'Created correct object type.'; |
9a920d27 |
67 | |
bc64165b |
68 | ## Test Tuple type constraint |
69 | |
65748864 |
70 | lives_ok sub { |
c3abf064 |
71 | $record->tuple([1,'hello', 'test.abc.test']); |
65748864 |
72 | } => 'Set tuple attribute without error'; |
73 | |
74 | is $record->tuple->[0], 1 |
75 | => 'correct set the tuple attribute index 0'; |
76 | |
77 | is $record->tuple->[1], 'hello' |
78 | => 'correct set the tuple attribute index 1'; |
79 | |
c3abf064 |
80 | is $record->tuple->[2], 'test.abc.test' |
81 | => 'correct set the tuple attribute index 2'; |
82 | |
83 | throws_ok sub { |
84 | $record->tuple([1,'hello', 'test.xxx.test']); |
85 | }, qr/Validation failed for 'MyString'/ |
86 | => 'Properly failed for bad value in custom type constraint'; |
87 | |
65748864 |
88 | throws_ok sub { |
c3abf064 |
89 | $record->tuple(['asdasd',2, 'test.abc.test']); |
65748864 |
90 | }, qr/Validation failed for 'Int'/ |
91 | => 'Got Expected Error for violating constraints'; |
92 | |
bc64165b |
93 | ## Test the Dictionary type constraint |
94 | |
95 | lives_ok sub { |
96 | $record->dict({name=>'frith', age=>23}); |
97 | } => 'Set dict attribute without error'; |
98 | |
99 | is $record->dict->{name}, 'frith' |
100 | => 'correct set the dict attribute name'; |
101 | |
102 | is $record->dict->{age}, 23 |
103 | => 'correct set the dict attribute age'; |
104 | |
105 | throws_ok sub { |
106 | $record->dict({name=>[1,2,3], age=>'sdfsdfsd'}); |
107 | }, qr/Validation failed for 'Str'/ |
108 | => 'Got Expected Error for bad value in dict'; |
8b276dd4 |
109 | |
110 | ## Test tuple_with_maybe |
111 | |
112 | lives_ok sub { |
113 | $record->tuple_with_maybe([1,'hello', 1]); |
114 | } => 'Set tuple attribute without error'; |
115 | |
116 | throws_ok sub { |
117 | $record->tuple_with_maybe([1,'hello', 'a']); |
118 | }, qr/Validation failed for 'Maybe\[Int\]'/ |
119 | => 'Properly failed for bad value parameterized constraint'; |
120 | |
121 | lives_ok sub { |
122 | $record->tuple_with_maybe([1,'hello']); |
123 | } => 'Set tuple attribute without error skipping optional parameter'; |
124 | |
125 | ## Test Tuple with parameterized type |
126 | |
127 | lives_ok sub { |
128 | $record->tuple_with_param([1,'hello', [1,2,3]]); |
129 | } => 'Set tuple attribute without error'; |
130 | |
131 | throws_ok sub { |
132 | $record->tuple_with_param([1,'hello', [qw/a b c/]]); |
133 | }, qr/Validation failed for 'ArrayRef\[Int\]'/ |
134 | => 'Properly failed for bad value parameterized constraint'; |
135 | |
136 | ## Test dict_with_maybe |
137 | |
138 | lives_ok sub { |
139 | $record->dict_with_maybe({name=>'frith', age=>23}); |
140 | } => 'Set dict attribute without error'; |
141 | |
142 | is $record->dict_with_maybe->{name}, 'frith' |
143 | => 'correct set the dict attribute name'; |
144 | |
145 | is $record->dict_with_maybe->{age}, 23 |
146 | => 'correct set the dict attribute age'; |
147 | |
148 | throws_ok sub { |
149 | $record->dict_with_maybe({name=>[1,2,3], age=>'sdfsdfsd'}); |
150 | }, qr/Validation failed for 'Str'/ |
151 | => 'Got Expected Error for bad value in dict'; |
152 | |
153 | throws_ok sub { |
154 | $record->dict_with_maybe({age=>30}); |
155 | }, qr/Validation failed for 'Str'/ |
156 | => 'Got Expected Error for missing named parameter'; |
157 | |
158 | lives_ok sub { |
159 | $record->dict_with_maybe({name=>'usal'}); |
160 | } => 'Set dict attribute without error, skipping optional'; |
9a920d27 |
161 | |
162 | ## Test dict_with_tuple |
163 | |
164 | lives_ok sub { |
165 | $record->dict_with_tuple({key1=>'Hello', key2=>[1,'World']}); |
166 | } => 'Set tuple attribute without error'; |
167 | |
168 | throws_ok sub { |
169 | $record->dict_with_tuple({key1=>'Hello', key2=>['World',2]}); |
170 | }, qr/Validation failed for 'Int'/ |
171 | => 'Threw error on bad constraint'; |
172 | |
173 | |
174 | |