Commit | Line | Data |
5c40cf37 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6 | use Test::Fatal; |
7 | use Test::More; |
8 | |
9 | use Moose::Util::TypeConstraints; |
10 | |
11 | #<<< |
12 | subtype 'Inlinable', |
13 | as 'Str', |
14 | where { $_ !~ /Q/ }, |
15 | inline_as { "defined $_[1] && ! ref $_[1] && $_[1] !~ /Q/" }; |
16 | |
17 | subtype 'NotInlinable', |
18 | as 'Str', |
19 | where { $_ !~ /Q/ }; |
20 | #>>> |
21 | |
22 | my $inlinable = find_type_constraint('Inlinable'); |
23 | my $not_inlinable = find_type_constraint('NotInlinable'); |
24 | |
25 | { |
26 | ok( |
27 | $inlinable->has_inlined_type_constraint, |
28 | 'Inlinable returns true for has_inlined_type_constraint' |
29 | ); |
30 | |
31 | is( |
32 | $inlinable->_inline_check('$foo'), |
33 | 'defined $foo && ! ref $foo && $foo !~ /Q/', |
34 | 'got expected inline code for Inlinable constraint' |
35 | ); |
36 | |
37 | ok( |
38 | !$not_inlinable->has_inlined_type_constraint, |
39 | 'NotInlinable returns false for has_inlined_type_constraint' |
40 | ); |
41 | |
42 | like( |
43 | exception { $not_inlinable->_inline_check('$foo') }, |
44 | qr/Cannot inline a type constraint check for NotInlinable/, |
45 | 'threw an exception when asking for inlinable code from type which cannot be inlined' |
46 | ); |
47 | } |
48 | |
49 | { |
50 | my $aofi = Moose::Util::TypeConstraints::find_or_create_type_constraint( |
51 | 'ArrayRef[Inlinable]'); |
52 | |
53 | ok( |
54 | $aofi->has_inlined_type_constraint, |
55 | 'ArrayRef[Inlinable] returns true for has_inlined_type_constraint' |
56 | ); |
57 | |
58 | is( |
59 | $aofi->_inline_check('$foo'), |
43837b8a |
60 | q{ref $foo eq 'ARRAY' && &List::MoreUtils::all( sub { defined $_ && ! ref $_ && $_ !~ /Q/ }, @{$foo} )}, |
5c40cf37 |
61 | 'got expected inline code for ArrayRef[Inlinable] constraint' |
62 | ); |
63 | |
64 | my $aofni = Moose::Util::TypeConstraints::find_or_create_type_constraint( |
65 | 'ArrayRef[NotInlinable]'); |
66 | |
67 | ok( |
68 | !$aofni->has_inlined_type_constraint, |
69 | 'ArrayRef[NotInlinable] returns false for has_inlined_type_constraint' |
70 | ); |
71 | } |
72 | |
73 | subtype 'ArrayOfInlinable', |
74 | as 'ArrayRef[Inlinable]'; |
75 | |
76 | subtype 'ArrayOfNotInlinable', |
77 | as 'ArrayRef[NotInlinable]'; |
78 | |
79 | { |
80 | local $TODO = 'A subtype of a Parameterized type should not be a Parameterizable type'; |
81 | |
82 | my $aofi = Moose::Util::TypeConstraints::find_or_create_type_constraint( |
43837b8a |
83 | 'ArrayOfInlinable'); |
5c40cf37 |
84 | |
85 | ok( |
86 | $aofi->has_inlined_type_constraint, |
87 | 'ArrayOfInlinable returns true for has_inlined_type_constraint' |
88 | ); |
89 | } |
90 | |
91 | { |
92 | my $hoaofi = Moose::Util::TypeConstraints::find_or_create_type_constraint( |
93 | 'HashRef[ArrayRef[Inlinable]]'); |
94 | |
95 | ok( |
96 | $hoaofi->has_inlined_type_constraint, |
97 | 'HashRef[ArrayRef[Inlinable]] returns true for has_inlined_type_constraint' |
98 | ); |
99 | |
100 | is( |
101 | $hoaofi->_inline_check('$foo'), |
43837b8a |
102 | q{ref $foo eq 'HASH' && &List::MoreUtils::all( sub { ref $_ eq 'ARRAY' && &List::MoreUtils::all( sub { defined $_ && ! ref $_ && $_ !~ /Q/ }, @{$_} ) }, values %{$foo} )}, |
5c40cf37 |
103 | 'got expected inline code for HashRef[ArrayRef[Inlinable]] constraint' |
104 | ); |
105 | |
106 | my $hoaofni = Moose::Util::TypeConstraints::find_or_create_type_constraint( |
107 | 'HashRef[ArrayRef[NotInlinable]]'); |
108 | |
109 | ok( |
110 | !$hoaofni->has_inlined_type_constraint, |
111 | 'HashRef[ArrayRef[NotInlinable]] returns false for has_inlined_type_constraint' |
112 | ); |
113 | } |
114 | |
115 | { |
116 | my $iunion = Moose::Util::TypeConstraints::find_or_create_type_constraint( |
117 | 'Inlinable | Object'); |
118 | |
119 | ok( |
120 | $iunion->has_inlined_type_constraint, |
121 | 'Inlinable | Object returns true for has_inlined_type_constraint' |
122 | ); |
123 | |
124 | is( |
125 | $iunion->_inline_check('$foo'), |
126 | '(defined $foo && ! ref $foo && $foo !~ /Q/) || (Scalar::Util::blessed( $foo ))', |
127 | 'got expected inline code for Inlinable | Object constraint' |
128 | ); |
129 | |
130 | my $niunion = Moose::Util::TypeConstraints::find_or_create_type_constraint( |
131 | 'NotInlinable | Object'); |
132 | |
133 | ok( |
134 | !$niunion->has_inlined_type_constraint, |
135 | 'NotInlinable | Object returns false for has_inlined_type_constraint' |
136 | ); |
137 | } |
138 | |
139 | { |
140 | my $iunion = Moose::Util::TypeConstraints::find_or_create_type_constraint( |
141 | 'Object | Inlinable'); |
142 | |
143 | ok( |
144 | $iunion->has_inlined_type_constraint, |
145 | 'Object | Inlinable returns true for has_inlined_type_constraint' |
146 | ); |
147 | |
148 | is( |
149 | $iunion->_inline_check('$foo'), |
150 | '(Scalar::Util::blessed( $foo )) || (defined $foo && ! ref $foo && $foo !~ /Q/)', |
151 | 'got expected inline code for Object | Inlinable constraint' |
152 | ); |
153 | |
154 | my $niunion = Moose::Util::TypeConstraints::find_or_create_type_constraint( |
155 | 'Object | NotInlinable'); |
156 | |
157 | ok( |
158 | !$niunion->has_inlined_type_constraint, |
159 | 'Object | NotInlinable returns false for has_inlined_type_constraint' |
160 | ); |
161 | } |
162 | |
163 | { |
164 | my $iunion = Moose::Util::TypeConstraints::find_or_create_type_constraint( |
165 | 'Object | Inlinable | CodeRef'); |
166 | |
167 | ok( |
168 | $iunion->has_inlined_type_constraint, |
169 | 'Object | Inlinable | CodeRef returns true for has_inlined_type_constraint' |
170 | ); |
171 | |
172 | is( |
173 | $iunion->_inline_check('$foo'), |
174 | q{(Scalar::Util::blessed( $foo )) || (defined $foo && ! ref $foo && $foo !~ /Q/) || (ref $foo eq 'CODE')}, |
175 | 'got expected inline code for Object | Inlinable | CodeRef constraint' |
176 | ); |
177 | |
178 | my $niunion = Moose::Util::TypeConstraints::find_or_create_type_constraint( |
179 | 'Object | NotInlinable | CodeRef'); |
180 | |
181 | ok( |
182 | !$niunion->has_inlined_type_constraint, |
183 | 'Object | NotInlinable | CodeRef returns false for has_inlined_type_constraint' |
184 | ); |
185 | } |
186 | |
5c40cf37 |
187 | done_testing; |