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