Commit | Line | Data |
65748864 |
1 | BEGIN { |
2 | use strict; |
3 | use warnings; |
8b276dd4 |
4 | use Test::More tests=>23; |
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; |
c3abf064 |
14 | |
15 | subtype 'MyString', |
16 | as 'Str', |
17 | where { $_=~m/abc/}; |
65748864 |
18 | |
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 { |
27941057 |
26 | Moose::Util::TypeConstraints::find_or_parse_type_constraint($_) |
8b276dd4 |
27 | } @args], |
bc64165b |
28 | ); |
29 | } |
30 | |
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 { |
38 | $_ => Moose::Util::TypeConstraints::find_or_parse_type_constraint($args{$_}) |
39 | } keys %args}, |
65748864 |
40 | ); |
41 | } |
c3abf064 |
42 | |
43 | has 'tuple' => (is=>'rw', isa=>Tuple['Int', 'Str', 'MyString']); |
bc64165b |
44 | has 'dict' => (is=>'rw', isa=>Dict[name=>'Str', age=>'Int']); |
8b276dd4 |
45 | has 'dict_with_maybe' => (is=>'rw', isa=>Dict[name=>'Str', age=>'Maybe[Int]']); |
46 | has 'tuple_with_param' => (is=>'rw', isa=>Tuple['Int', 'Str', 'ArrayRef[Int]']); |
47 | has 'tuple_with_maybe' => (is=>'rw', isa=>Tuple['Int', 'Str', 'Maybe[Int]']); |
65748864 |
48 | } |
49 | |
50 | ## Instantiate a new test object |
51 | |
bc64165b |
52 | ok my $record = Test::MooseX::Meta::TypeConstraint::Structured->new |
65748864 |
53 | => 'Instantiated new Record test class.'; |
54 | |
bc64165b |
55 | isa_ok $record => 'Test::MooseX::Meta::TypeConstraint::Structured' |
65748864 |
56 | => 'Created correct object type.'; |
8b276dd4 |
57 | |
bc64165b |
58 | ## Test Tuple type constraint |
59 | |
65748864 |
60 | lives_ok sub { |
c3abf064 |
61 | $record->tuple([1,'hello', 'test.abc.test']); |
65748864 |
62 | } => 'Set tuple attribute without error'; |
63 | |
64 | is $record->tuple->[0], 1 |
65 | => 'correct set the tuple attribute index 0'; |
66 | |
67 | is $record->tuple->[1], 'hello' |
68 | => 'correct set the tuple attribute index 1'; |
69 | |
c3abf064 |
70 | is $record->tuple->[2], 'test.abc.test' |
71 | => 'correct set the tuple attribute index 2'; |
72 | |
73 | throws_ok sub { |
74 | $record->tuple([1,'hello', 'test.xxx.test']); |
75 | }, qr/Validation failed for 'MyString'/ |
76 | => 'Properly failed for bad value in custom type constraint'; |
77 | |
65748864 |
78 | throws_ok sub { |
c3abf064 |
79 | $record->tuple(['asdasd',2, 'test.abc.test']); |
65748864 |
80 | }, qr/Validation failed for 'Int'/ |
81 | => 'Got Expected Error for violating constraints'; |
82 | |
bc64165b |
83 | ## Test the Dictionary type constraint |
84 | |
85 | lives_ok sub { |
86 | $record->dict({name=>'frith', age=>23}); |
87 | } => 'Set dict attribute without error'; |
88 | |
89 | is $record->dict->{name}, 'frith' |
90 | => 'correct set the dict attribute name'; |
91 | |
92 | is $record->dict->{age}, 23 |
93 | => 'correct set the dict attribute age'; |
94 | |
95 | throws_ok sub { |
96 | $record->dict({name=>[1,2,3], age=>'sdfsdfsd'}); |
97 | }, qr/Validation failed for 'Str'/ |
98 | => 'Got Expected Error for bad value in dict'; |
8b276dd4 |
99 | |
100 | ## Test tuple_with_maybe |
101 | |
102 | lives_ok sub { |
103 | $record->tuple_with_maybe([1,'hello', 1]); |
104 | } => 'Set tuple attribute without error'; |
105 | |
106 | throws_ok sub { |
107 | $record->tuple_with_maybe([1,'hello', 'a']); |
108 | }, qr/Validation failed for 'Maybe\[Int\]'/ |
109 | => 'Properly failed for bad value parameterized constraint'; |
110 | |
111 | lives_ok sub { |
112 | $record->tuple_with_maybe([1,'hello']); |
113 | } => 'Set tuple attribute without error skipping optional parameter'; |
114 | |
115 | ## Test Tuple with parameterized type |
116 | |
117 | lives_ok sub { |
118 | $record->tuple_with_param([1,'hello', [1,2,3]]); |
119 | } => 'Set tuple attribute without error'; |
120 | |
121 | throws_ok sub { |
122 | $record->tuple_with_param([1,'hello', [qw/a b c/]]); |
123 | }, qr/Validation failed for 'ArrayRef\[Int\]'/ |
124 | => 'Properly failed for bad value parameterized constraint'; |
125 | |
126 | ## Test dict_with_maybe |
127 | |
128 | lives_ok sub { |
129 | $record->dict_with_maybe({name=>'frith', age=>23}); |
130 | } => 'Set dict attribute without error'; |
131 | |
132 | is $record->dict_with_maybe->{name}, 'frith' |
133 | => 'correct set the dict attribute name'; |
134 | |
135 | is $record->dict_with_maybe->{age}, 23 |
136 | => 'correct set the dict attribute age'; |
137 | |
138 | throws_ok sub { |
139 | $record->dict_with_maybe({name=>[1,2,3], age=>'sdfsdfsd'}); |
140 | }, qr/Validation failed for 'Str'/ |
141 | => 'Got Expected Error for bad value in dict'; |
142 | |
143 | throws_ok sub { |
144 | $record->dict_with_maybe({age=>30}); |
145 | }, qr/Validation failed for 'Str'/ |
146 | => 'Got Expected Error for missing named parameter'; |
147 | |
148 | lives_ok sub { |
149 | $record->dict_with_maybe({name=>'usal'}); |
150 | } => 'Set dict attribute without error, skipping optional'; |
151 | |