Commit | Line | Data |
451c8248 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
a28e50e4 |
6 | use Test::More; |
451c8248 |
7 | |
28fdde7f |
8 | use Moose::Util::TypeConstraints; |
451c8248 |
9 | |
10 | my $Str = find_type_constraint('Str'); |
b53f21ca |
11 | isa_ok( $Str, 'Moose::Meta::TypeConstraint' ); |
451c8248 |
12 | |
13 | my $Undef = find_type_constraint('Undef'); |
b53f21ca |
14 | isa_ok( $Undef, 'Moose::Meta::TypeConstraint' ); |
15 | |
16 | ok( !$Str->check(undef), '... Str cannot accept an Undef value' ); |
17 | ok( $Str->check('String'), '... Str can accept an String value' ); |
18 | ok( !$Undef->check('String'), '... Undef cannot accept an Str value' ); |
19 | ok( $Undef->check(undef), '... Undef can accept an Undef value' ); |
20 | |
21 | my $Str_or_Undef = Moose::Meta::TypeConstraint::Union->new( |
22 | type_constraints => [ $Str, $Undef ] ); |
23 | isa_ok( $Str_or_Undef, 'Moose::Meta::TypeConstraint::Union' ); |
24 | |
25 | ok( |
26 | $Str_or_Undef->check(undef), |
27 | '... (Str | Undef) can accept an Undef value' |
28 | ); |
29 | ok( |
30 | $Str_or_Undef->check('String'), |
31 | '... (Str | Undef) can accept a String value' |
32 | ); |
33 | |
34 | ok( !$Str_or_Undef->is_a_type_of($Str), "not a subtype of Str" ); |
35 | ok( !$Str_or_Undef->is_a_type_of($Undef), "not a subtype of Undef" ); |
36 | |
37 | cmp_ok( |
38 | $Str_or_Undef->find_type_for('String'), 'eq', 'Str', |
39 | 'find_type_for Str' |
40 | ); |
41 | cmp_ok( |
42 | $Str_or_Undef->find_type_for(undef), 'eq', 'Undef', |
43 | 'find_type_for Undef' |
44 | ); |
45 | ok( |
46 | !defined( $Str_or_Undef->find_type_for( sub { } ) ), |
47 | 'no find_type_for CodeRef' |
48 | ); |
49 | |
50 | ok( !$Str_or_Undef->equals($Str), "not equal to Str" ); |
dabed765 |
51 | ok( $Str_or_Undef->equals($Str_or_Undef), "equal to self" ); |
b53f21ca |
52 | ok( |
53 | $Str_or_Undef->equals( |
54 | Moose::Meta::TypeConstraint::Union->new( |
55 | type_constraints => [ $Str, $Undef ] |
56 | ) |
57 | ), |
58 | "equal to clone" |
59 | ); |
60 | ok( |
61 | $Str_or_Undef->equals( |
62 | Moose::Meta::TypeConstraint::Union->new( |
63 | type_constraints => [ $Undef, $Str ] |
64 | ) |
65 | ), |
66 | "equal to reversed clone" |
67 | ); |
68 | |
69 | ok( |
70 | !$Str_or_Undef->is_a_type_of("ThisTypeDoesNotExist"), |
71 | "not type of non existent type" |
72 | ); |
73 | ok( |
74 | !$Str_or_Undef->is_subtype_of("ThisTypeDoesNotExist"), |
75 | "not subtype of non existent type" |
76 | ); |
4c015454 |
77 | |
c4663f6f |
78 | is( |
79 | $Str_or_Undef->parent, |
80 | find_type_constraint('Item'), |
81 | 'parent of Str|Undef is Item' |
82 | ); |
83 | |
74cd1c84 |
84 | is_deeply( |
85 | [$Str_or_Undef->parents], |
86 | [find_type_constraint('Item')], |
c4663f6f |
87 | 'parents of Str|Undef is Item' |
88 | ); |
89 | |
451c8248 |
90 | # another .... |
91 | |
92 | my $ArrayRef = find_type_constraint('ArrayRef'); |
b53f21ca |
93 | isa_ok( $ArrayRef, 'Moose::Meta::TypeConstraint' ); |
451c8248 |
94 | |
95 | my $HashRef = find_type_constraint('HashRef'); |
b53f21ca |
96 | isa_ok( $HashRef, 'Moose::Meta::TypeConstraint' ); |
97 | |
98 | ok( $ArrayRef->check( [] ), '... ArrayRef can accept an [] value' ); |
99 | ok( !$ArrayRef->check( {} ), '... ArrayRef cannot accept an {} value' ); |
100 | ok( $HashRef->check( {} ), '... HashRef can accept an {} value' ); |
101 | ok( !$HashRef->check( [] ), '... HashRef cannot accept an [] value' ); |
102 | |
d61b2684 |
103 | my $ArrayRef_or_HashRef = Moose::Meta::TypeConstraint::Union->new( |
b53f21ca |
104 | type_constraints => [ $ArrayRef, $HashRef ] ); |
d61b2684 |
105 | isa_ok( $ArrayRef_or_HashRef, 'Moose::Meta::TypeConstraint::Union' ); |
b53f21ca |
106 | |
d61b2684 |
107 | ok( $ArrayRef_or_HashRef->check( [] ), |
108 | '... (ArrayRef | HashRef) can accept []' ); |
109 | ok( $ArrayRef_or_HashRef->check( {} ), |
110 | '... (ArrayRef | HashRef) can accept {}' ); |
b53f21ca |
111 | |
112 | ok( |
d61b2684 |
113 | !$ArrayRef_or_HashRef->check( \( my $var1 ) ), |
b53f21ca |
114 | '... (ArrayRef | HashRef) cannot accept scalar refs' |
115 | ); |
116 | ok( |
d61b2684 |
117 | !$ArrayRef_or_HashRef->check( sub { } ), |
b53f21ca |
118 | '... (ArrayRef | HashRef) cannot accept code refs' |
119 | ); |
120 | ok( |
d61b2684 |
121 | !$ArrayRef_or_HashRef->check(50), |
b53f21ca |
122 | '... (ArrayRef | HashRef) cannot accept Numbers' |
123 | ); |
124 | |
d61b2684 |
125 | diag $ArrayRef_or_HashRef->validate( [] ); |
b53f21ca |
126 | |
127 | ok( |
d61b2684 |
128 | !defined( $ArrayRef_or_HashRef->validate( [] ) ), |
b53f21ca |
129 | '... (ArrayRef | HashRef) can accept []' |
130 | ); |
131 | ok( |
d61b2684 |
132 | !defined( $ArrayRef_or_HashRef->validate( {} ) ), |
b53f21ca |
133 | '... (ArrayRef | HashRef) can accept {}' |
134 | ); |
135 | |
136 | like( |
d61b2684 |
137 | $ArrayRef_or_HashRef->validate( \( my $var2 ) ), |
b53f21ca |
138 | qr/Validation failed for \'ArrayRef\' with value .+ and Validation failed for \'HashRef\' with value .+ in \(ArrayRef\|HashRef\)/, |
139 | '... (ArrayRef | HashRef) cannot accept scalar refs' |
140 | ); |
141 | |
142 | like( |
d61b2684 |
143 | $ArrayRef_or_HashRef->validate( sub { } ), |
b53f21ca |
144 | qr/Validation failed for \'ArrayRef\' with value .+ and Validation failed for \'HashRef\' with value .+ in \(ArrayRef\|HashRef\)/, |
145 | '... (ArrayRef | HashRef) cannot accept code refs' |
146 | ); |
147 | |
148 | is( |
d61b2684 |
149 | $ArrayRef_or_HashRef->validate(50), |
b53f21ca |
150 | 'Validation failed for \'ArrayRef\' with value 50 and Validation failed for \'HashRef\' with value 50 in (ArrayRef|HashRef)', |
151 | '... (ArrayRef | HashRef) cannot accept Numbers' |
152 | ); |
451c8248 |
153 | |
8942e607 |
154 | is( |
155 | $ArrayRef_or_HashRef->parent, |
156 | find_type_constraint('Ref'), |
157 | 'parent of ArrayRef|HashRef is Ref' |
158 | ); |
159 | |
491f96de |
160 | my $double_union = Moose::Meta::TypeConstraint::Union->new( |
161 | type_constraints => [ $Str_or_Undef, $ArrayRef_or_HashRef ] ); |
162 | |
163 | is( |
164 | $double_union->parent, |
165 | find_type_constraint('Item'), |
166 | 'parent of (Str|Undef)|(ArrayRef|HashRef) is Item' |
167 | ); |
168 | |
169 | ok( |
170 | $double_union->is_subtype_of('Item'), |
171 | '(Str|Undef)|(ArrayRef|HashRef) is a subtype of Item' |
172 | ); |
173 | |
174 | ok( |
175 | $double_union->is_a_type_of('Item'), |
176 | '(Str|Undef)|(ArrayRef|HashRef) is a type of Item' |
177 | ); |
178 | |
179 | ok( |
180 | !$double_union->is_a_type_of('Str'), |
181 | '(Str|Undef)|(ArrayRef|HashRef) is not a type of Str' |
182 | ); |
183 | |
86036fe3 |
184 | type 'SomeType', where { 1 }; |
185 | type 'OtherType', where { 1 }; |
186 | |
187 | my $parentless_union = Moose::Meta::TypeConstraint::Union->new( |
188 | type_constraints => [ |
189 | find_type_constraint('SomeType'), |
190 | find_type_constraint('OtherType'), |
191 | ], |
192 | ); |
193 | |
194 | is($parentless_union->parent, undef, "no common ancestor gives undef parent"); |
195 | |
196 | |
a28e50e4 |
197 | done_testing; |