line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Type::Tiny; |
2
|
|
|
|
|
|
|
|
3
|
279
|
|
|
279
|
|
287429
|
use 5.008001; |
|
279
|
|
|
|
|
1269
|
|
4
|
279
|
|
|
279
|
|
1660
|
use strict; |
|
279
|
|
|
|
|
559
|
|
|
279
|
|
|
|
|
5918
|
|
5
|
279
|
|
|
279
|
|
1346
|
use warnings; |
|
279
|
|
|
|
|
587
|
|
|
279
|
|
|
|
|
13476
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
BEGIN { |
8
|
279
|
50
|
|
279
|
|
12943
|
if ( $] < 5.010 ) { require Devel::TypeTiny::Perl58Compat } |
|
0
|
|
|
|
|
0
|
|
9
|
|
|
|
|
|
|
} |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
BEGIN { |
12
|
279
|
|
|
279
|
|
942
|
$Type::Tiny::AUTHORITY = 'cpan:TOBYINK'; |
13
|
279
|
|
|
|
|
584
|
$Type::Tiny::VERSION = '2.004000'; |
14
|
279
|
|
|
|
|
30710
|
$Type::Tiny::XS_VERSION = '0.016'; |
15
|
|
|
|
|
|
|
} |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
$Type::Tiny::VERSION =~ tr/_//d; |
18
|
|
|
|
|
|
|
$Type::Tiny::XS_VERSION =~ tr/_//d; |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
our @InternalPackages = qw( |
21
|
|
|
|
|
|
|
Devel::TypeTiny::Perl56Compat |
22
|
|
|
|
|
|
|
Devel::TypeTiny::Perl58Compat |
23
|
|
|
|
|
|
|
Error::TypeTiny |
24
|
|
|
|
|
|
|
Error::TypeTiny::Assertion |
25
|
|
|
|
|
|
|
Error::TypeTiny::Compilation |
26
|
|
|
|
|
|
|
Error::TypeTiny::WrongNumberOfParameters |
27
|
|
|
|
|
|
|
Eval::TypeTiny |
28
|
|
|
|
|
|
|
Eval::TypeTiny::CodeAccumulator |
29
|
|
|
|
|
|
|
Eval::TypeTiny::Sandbox |
30
|
|
|
|
|
|
|
Exporter::Tiny |
31
|
|
|
|
|
|
|
Reply::Plugin::TypeTiny |
32
|
|
|
|
|
|
|
Test::TypeTiny |
33
|
|
|
|
|
|
|
Type::Coercion |
34
|
|
|
|
|
|
|
Type::Coercion::FromMoose |
35
|
|
|
|
|
|
|
Type::Coercion::Union |
36
|
|
|
|
|
|
|
Type::Library |
37
|
|
|
|
|
|
|
Type::Params |
38
|
|
|
|
|
|
|
Type::Params::Alternatives |
39
|
|
|
|
|
|
|
Type::Params::Parameter |
40
|
|
|
|
|
|
|
Type::Params::Signature |
41
|
|
|
|
|
|
|
Type::Parser |
42
|
|
|
|
|
|
|
Type::Parser::AstBuilder |
43
|
|
|
|
|
|
|
Type::Parser::Token |
44
|
|
|
|
|
|
|
Type::Parser::TokenStream |
45
|
|
|
|
|
|
|
Type::Registry |
46
|
|
|
|
|
|
|
Types::Common |
47
|
|
|
|
|
|
|
Types::Common::Numeric |
48
|
|
|
|
|
|
|
Types::Common::String |
49
|
|
|
|
|
|
|
Types::Standard |
50
|
|
|
|
|
|
|
Types::Standard::_Stringable |
51
|
|
|
|
|
|
|
Types::Standard::ArrayRef |
52
|
|
|
|
|
|
|
Types::Standard::CycleTuple |
53
|
|
|
|
|
|
|
Types::Standard::Dict |
54
|
|
|
|
|
|
|
Types::Standard::HashRef |
55
|
|
|
|
|
|
|
Types::Standard::Map |
56
|
|
|
|
|
|
|
Types::Standard::ScalarRef |
57
|
|
|
|
|
|
|
Types::Standard::StrMatch |
58
|
|
|
|
|
|
|
Types::Standard::Tied |
59
|
|
|
|
|
|
|
Types::Standard::Tuple |
60
|
|
|
|
|
|
|
Types::TypeTiny |
61
|
|
|
|
|
|
|
Type::Tie |
62
|
|
|
|
|
|
|
Type::Tie::ARRAY |
63
|
|
|
|
|
|
|
Type::Tie::BASE |
64
|
|
|
|
|
|
|
Type::Tie::HASH |
65
|
|
|
|
|
|
|
Type::Tie::SCALAR |
66
|
|
|
|
|
|
|
Type::Tiny |
67
|
|
|
|
|
|
|
Type::Tiny::_DeclaredType |
68
|
|
|
|
|
|
|
Type::Tiny::_HalfOp |
69
|
|
|
|
|
|
|
Type::Tiny::Class |
70
|
|
|
|
|
|
|
Type::Tiny::ConsrtainedObject |
71
|
|
|
|
|
|
|
Type::Tiny::Duck |
72
|
|
|
|
|
|
|
Type::Tiny::Enum |
73
|
|
|
|
|
|
|
Type::Tiny::Intersection |
74
|
|
|
|
|
|
|
Type::Tiny::Role |
75
|
|
|
|
|
|
|
Type::Tiny::Union |
76
|
|
|
|
|
|
|
Type::Utils |
77
|
|
|
|
|
|
|
); |
78
|
|
|
|
|
|
|
|
79
|
279
|
|
|
279
|
|
2166
|
use Scalar::Util qw( blessed ); |
|
279
|
|
|
|
|
593
|
|
|
279
|
|
|
|
|
15011
|
|
80
|
279
|
|
|
279
|
|
73465
|
use Types::TypeTiny (); |
|
279
|
|
|
|
|
765
|
|
|
279
|
|
|
|
|
112712
|
|
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
our $SafePackage = sprintf 'package %s;', __PACKAGE__; |
83
|
|
|
|
|
|
|
|
84
|
15
|
|
|
15
|
|
230
|
sub _croak ($;@) { require Error::TypeTiny; goto \&Error::TypeTiny::croak } |
|
15
|
|
|
|
|
89
|
|
85
|
|
|
|
|
|
|
|
86
|
40153
|
50
|
|
40153
|
|
138872
|
sub _swap { $_[2] ? @_[ 1, 0 ] : @_[ 0, 1 ] } |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
BEGIN { |
89
|
279
|
|
|
279
|
|
1601
|
my $support_smartmatch = 0+ !!( $] >= 5.010001 ); |
90
|
279
|
|
|
|
|
18152
|
eval qq{ sub SUPPORT_SMARTMATCH () { !! $support_smartmatch } }; |
91
|
|
|
|
|
|
|
|
92
|
279
|
|
|
|
|
2781
|
my $fixed_precedence = 0+ !!( $] >= 5.014 ); |
93
|
279
|
|
|
|
|
11473
|
eval qq{ sub _FIXED_PRECEDENCE () { !! $fixed_precedence } }; |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
my $try_xs = |
96
|
|
|
|
|
|
|
exists( $ENV{PERL_TYPE_TINY_XS} ) ? !!$ENV{PERL_TYPE_TINY_XS} |
97
|
|
|
|
|
|
|
: exists( $ENV{PERL_ONLY} ) ? !$ENV{PERL_ONLY} |
98
|
279
|
50
|
|
|
|
2407
|
: 1; |
|
|
50
|
|
|
|
|
|
99
|
|
|
|
|
|
|
|
100
|
279
|
|
|
|
|
602
|
my $use_xs = 0; |
101
|
279
|
50
|
|
|
|
1086
|
$try_xs and eval { |
102
|
279
|
|
|
|
|
1724
|
require Type::Tiny::XS; |
103
|
279
|
|
|
|
|
3288
|
'Type::Tiny::XS'->VERSION( $Type::Tiny::XS_VERSION ); |
104
|
279
|
|
|
|
|
1047
|
$use_xs++; |
105
|
|
|
|
|
|
|
}; |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
*_USE_XS = |
108
|
|
|
|
|
|
|
$use_xs |
109
|
|
|
|
|
|
|
? sub () { !!1 } |
110
|
279
|
50
|
|
|
|
1230
|
: sub () { !!0 }; |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
*_USE_MOUSE = |
113
|
|
|
|
|
|
|
$try_xs |
114
|
261
|
50
|
|
261
|
|
2467
|
? sub () { $INC{'Mouse/Util.pm'} and Mouse::Util::MOUSE_XS() } |
115
|
279
|
50
|
|
|
|
1482
|
: sub () { !!0 }; |
116
|
|
|
|
|
|
|
|
117
|
279
|
|
|
|
|
605
|
my $strict_mode = 0; |
118
|
279
|
|
100
|
|
|
2798
|
$ENV{$_} && ++$strict_mode for qw( |
119
|
|
|
|
|
|
|
EXTENDED_TESTING |
120
|
|
|
|
|
|
|
AUTHOR_TESTING |
121
|
|
|
|
|
|
|
RELEASE_TESTING |
122
|
|
|
|
|
|
|
PERL_STRICT |
123
|
|
|
|
|
|
|
); |
124
|
279
|
100
|
|
|
|
9638
|
*_STRICT_MODE = $strict_mode ? sub () { !!1 } : sub () { !!0 }; |
125
|
|
|
|
|
|
|
} #/ BEGIN |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
{ |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
sub _install_overloads { |
130
|
279
|
|
|
279
|
|
1828
|
no strict 'refs'; |
|
279
|
|
|
|
|
735
|
|
|
279
|
|
|
|
|
9527
|
|
131
|
279
|
|
|
279
|
|
1606
|
no warnings 'redefine', 'once'; |
|
279
|
|
|
|
|
641
|
|
|
279
|
|
|
|
|
3140310
|
|
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
# Coverage is checked on Perl 5.26 |
134
|
1942
|
50
|
|
1942
|
|
6843
|
if ( $] < 5.010 ) { # uncoverable statement |
135
|
0
|
|
|
|
|
0
|
require overload; # uncoverable statement |
136
|
0
|
|
|
|
|
0
|
push @_, fallback => 1; # uncoverable statement |
137
|
0
|
|
|
|
|
0
|
goto \&overload::OVERLOAD; # uncoverable statement |
138
|
|
|
|
|
|
|
} |
139
|
|
|
|
|
|
|
|
140
|
1942
|
|
|
|
|
4005
|
my $class = shift; |
141
|
1942
|
|
|
0
|
|
5246
|
*{ $class . '::((' } = sub { }; |
|
1942
|
|
|
|
|
10975
|
|
142
|
1942
|
|
|
0
|
|
5750
|
*{ $class . '::()' } = sub { }; |
|
1942
|
|
|
|
|
7856
|
|
143
|
1942
|
|
|
|
|
3401
|
*{ $class . '::()' } = do { my $x = 1; \$x }; |
|
1942
|
|
|
|
|
4741
|
|
|
1942
|
|
|
|
|
2931
|
|
|
1942
|
|
|
|
|
3280
|
|
144
|
1942
|
|
|
|
|
5504
|
while ( @_ ) { |
145
|
6921
|
|
|
|
|
10396
|
my $f = shift; |
146
|
6921
|
100
|
|
|
|
12770
|
*{ $class . '::(' . $f } = ref $_[0] ? shift : do { |
|
6921
|
|
|
|
|
31242
|
|
147
|
542
|
|
|
|
|
1170
|
my $m = shift; |
148
|
715
|
|
|
715
|
|
78233
|
sub { shift->$m( @_ ) } |
149
|
542
|
|
|
|
|
2164
|
}; |
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
} #/ sub _install_overloads |
152
|
|
|
|
|
|
|
} |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
__PACKAGE__->_install_overloads( |
155
|
|
|
|
|
|
|
q("") => sub { |
156
|
44966
|
50
|
|
44966
|
|
241205
|
caller =~ m{^(Moo::HandleMoose|Sub::Quote)} |
157
|
|
|
|
|
|
|
? $_[0]->_stringify_no_magic |
158
|
|
|
|
|
|
|
: $_[0]->display_name; |
159
|
|
|
|
|
|
|
}, |
160
|
42006
|
|
|
42006
|
|
113939
|
q(bool) => sub { 1 }, |
161
|
|
|
|
|
|
|
q(&{}) => "_overload_coderef", |
162
|
|
|
|
|
|
|
q(|) => sub { |
163
|
64
|
|
|
64
|
|
3708
|
my @tc = _swap @_; |
164
|
64
|
|
|
|
|
101
|
if ( !_FIXED_PRECEDENCE && $_[2] ) { |
165
|
|
|
|
|
|
|
if ( blessed $tc[0] ) { |
166
|
|
|
|
|
|
|
if ( blessed $tc[0] eq "Type::Tiny::_HalfOp" ) { |
167
|
|
|
|
|
|
|
my $type = $tc[0]->{type}; |
168
|
|
|
|
|
|
|
my $param = $tc[0]->{param}; |
169
|
|
|
|
|
|
|
my $op = $tc[0]->{op}; |
170
|
|
|
|
|
|
|
require Type::Tiny::Union; |
171
|
|
|
|
|
|
|
return "Type::Tiny::_HalfOp"->new( |
172
|
|
|
|
|
|
|
$op, |
173
|
|
|
|
|
|
|
$param, |
174
|
|
|
|
|
|
|
"Type::Tiny::Union"->new_by_overload( type_constraints => [ $type, $tc[1] ] ), |
175
|
|
|
|
|
|
|
); |
176
|
|
|
|
|
|
|
} #/ if ( blessed $tc[0] eq...) |
177
|
|
|
|
|
|
|
} #/ if ( blessed $tc[0] ) |
178
|
|
|
|
|
|
|
elsif ( ref $tc[0] eq 'ARRAY' ) { |
179
|
|
|
|
|
|
|
require Type::Tiny::_HalfOp; |
180
|
|
|
|
|
|
|
return "Type::Tiny::_HalfOp"->new( '|', @tc ); |
181
|
|
|
|
|
|
|
} |
182
|
|
|
|
|
|
|
} #/ if ( !_FIXED_PRECEDENCE...) |
183
|
64
|
|
|
|
|
9485
|
require Type::Tiny::Union; |
184
|
64
|
|
|
|
|
338
|
return "Type::Tiny::Union"->new_by_overload( type_constraints => \@tc ); |
185
|
|
|
|
|
|
|
}, |
186
|
|
|
|
|
|
|
q(&) => sub { |
187
|
40059
|
|
|
40059
|
|
1765461
|
my @tc = _swap @_; |
188
|
40059
|
|
|
|
|
66165
|
if ( !_FIXED_PRECEDENCE && $_[2] ) { |
189
|
|
|
|
|
|
|
if ( blessed $tc[0] ) { |
190
|
|
|
|
|
|
|
if ( blessed $tc[0] eq "Type::Tiny::_HalfOp" ) { |
191
|
|
|
|
|
|
|
my $type = $tc[0]->{type}; |
192
|
|
|
|
|
|
|
my $param = $tc[0]->{param}; |
193
|
|
|
|
|
|
|
my $op = $tc[0]->{op}; |
194
|
|
|
|
|
|
|
require Type::Tiny::Intersection; |
195
|
|
|
|
|
|
|
return "Type::Tiny::_HalfOp"->new( |
196
|
|
|
|
|
|
|
$op, |
197
|
|
|
|
|
|
|
$param, |
198
|
|
|
|
|
|
|
"Type::Tiny::Intersection"->new_by_overload( type_constraints => [ $type, $tc[1] ] ), |
199
|
|
|
|
|
|
|
); |
200
|
|
|
|
|
|
|
} #/ if ( blessed $tc[0] eq...) |
201
|
|
|
|
|
|
|
} #/ if ( blessed $tc[0] ) |
202
|
|
|
|
|
|
|
elsif ( ref $tc[0] eq 'ARRAY' ) { |
203
|
|
|
|
|
|
|
require Type::Tiny::_HalfOp; |
204
|
|
|
|
|
|
|
return "Type::Tiny::_HalfOp"->new( '&', @tc ); |
205
|
|
|
|
|
|
|
} |
206
|
|
|
|
|
|
|
} #/ if ( !_FIXED_PRECEDENCE...) |
207
|
40059
|
|
|
|
|
199381
|
require Type::Tiny::Intersection; |
208
|
40059
|
|
|
|
|
135872
|
"Type::Tiny::Intersection"->new_by_overload( type_constraints => \@tc ); |
209
|
|
|
|
|
|
|
}, |
210
|
69
|
|
|
69
|
|
1408
|
q(~) => sub { shift->complementary_type }, |
211
|
699
|
|
|
699
|
|
6746
|
q(==) => sub { $_[0]->equals( $_[1] ) }, |
212
|
1
|
|
|
1
|
|
6
|
q(!=) => sub { not $_[0]->equals( $_[1] ) }, |
213
|
8
|
|
|
8
|
|
71
|
q(<) => sub { my $m = $_[0]->can( 'is_subtype_of' ); $m->( _swap @_ ) }, |
|
8
|
|
|
|
|
26
|
|
214
|
|
|
|
|
|
|
q(>) => sub { |
215
|
10
|
|
|
10
|
|
100
|
my $m = $_[0]->can( 'is_subtype_of' ); |
216
|
10
|
|
|
|
|
32
|
$m->( reverse _swap @_ ); |
217
|
|
|
|
|
|
|
}, |
218
|
6
|
|
|
6
|
|
58
|
q(<=) => sub { my $m = $_[0]->can( 'is_a_type_of' ); $m->( _swap @_ ) }, |
|
6
|
|
|
|
|
15
|
|
219
|
|
|
|
|
|
|
q(>=) => sub { |
220
|
6
|
|
|
6
|
|
88
|
my $m = $_[0]->can( 'is_a_type_of' ); |
221
|
6
|
|
|
|
|
16
|
$m->( reverse _swap @_ ); |
222
|
|
|
|
|
|
|
}, |
223
|
27
|
|
|
27
|
|
7536
|
q(eq) => sub { "$_[0]" eq "$_[1]" }, |
224
|
0
|
0
|
|
0
|
|
0
|
q(cmp) => sub { $_[2] ? ( "$_[1]" cmp "$_[0]" ) : ( "$_[0]" cmp "$_[1]" ) }, |
225
|
1
|
|
|
1
|
|
64
|
q(0+) => sub { $_[0]{uniq} }, |
226
|
4
|
100
|
50
|
4
|
|
3320
|
q(/) => sub { ( _STRICT_MODE xor $_[2] ) ? $_[0] : $_[1] }, |
227
|
|
|
|
|
|
|
); |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
__PACKAGE__->_install_overloads( |
230
|
3
|
|
|
3
|
|
588
|
q(~~) => sub { $_[0]->check( $_[1] ) }, |
231
|
|
|
|
|
|
|
) if Type::Tiny::SUPPORT_SMARTMATCH; |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
# Would be easy to just return sub { $self->assert_return(@_) } |
234
|
|
|
|
|
|
|
# but try to build a more efficient coderef whenever possible. |
235
|
|
|
|
|
|
|
# |
236
|
|
|
|
|
|
|
sub _overload_coderef { |
237
|
12845
|
|
|
12845
|
|
28403
|
my $self = shift; |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
# Bypass generating a coderef if we've already got the best possible one. |
240
|
|
|
|
|
|
|
# |
241
|
12845
|
100
|
|
|
|
39307
|
return $self->{_overload_coderef} if $self->{_overload_coderef_no_rebuild}; |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
# Subclasses of Type::Tiny might override assert_return to do some kind |
244
|
|
|
|
|
|
|
# of interesting thing. In that case, we can't rely on it having identical |
245
|
|
|
|
|
|
|
# behaviour to Type::Tiny::inline_assert. |
246
|
|
|
|
|
|
|
# |
247
|
|
|
|
|
|
|
$self->{_overrides_assert_return} = |
248
|
|
|
|
|
|
|
( $self->can( 'assert_return' ) != \&assert_return ) |
249
|
12826
|
100
|
|
|
|
38871
|
unless exists $self->{_overrides_assert_return}; |
250
|
|
|
|
|
|
|
|
251
|
12826
|
100
|
|
|
|
39083
|
if ( $self->{_overrides_assert_return} ) { |
|
|
100
|
|
|
|
|
|
252
|
1
|
|
33
|
|
|
7
|
$self->{_overload_coderef} ||= do { |
253
|
1
|
|
|
|
|
4
|
Scalar::Util::weaken( my $weak = $self ); |
254
|
1
|
|
|
2
|
|
6
|
sub { $weak->assert_return( @_ ) }; |
|
2
|
|
|
|
|
11
|
|
255
|
|
|
|
|
|
|
}; |
256
|
1
|
|
|
|
|
3
|
++$self->{_overload_coderef_no_rebuild}; |
257
|
|
|
|
|
|
|
} |
258
|
|
|
|
|
|
|
elsif ( exists( &Sub::Quote::quote_sub ) ) { |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
# Use `=` instead of `||=` because we want to overwrite non-Sub::Quote |
261
|
|
|
|
|
|
|
# coderef if possible. |
262
|
162
|
100
|
|
|
|
356
|
$self->{_overload_coderef} = $self->can_be_inlined |
263
|
|
|
|
|
|
|
? Sub::Quote::quote_sub( |
264
|
|
|
|
|
|
|
$self->inline_assert( '$_[0]' ), |
265
|
|
|
|
|
|
|
) |
266
|
|
|
|
|
|
|
: Sub::Quote::quote_sub( |
267
|
|
|
|
|
|
|
$self->inline_assert( '$_[0]', '$type' ), |
268
|
|
|
|
|
|
|
{ '$type' => \$self }, |
269
|
|
|
|
|
|
|
); |
270
|
162
|
|
|
|
|
12957
|
++$self->{_overload_coderef_no_rebuild}; |
271
|
|
|
|
|
|
|
} #/ elsif ( exists( &Sub::Quote::quote_sub...)) |
272
|
|
|
|
|
|
|
else { |
273
|
12663
|
|
|
|
|
67637
|
require Eval::TypeTiny; |
274
|
12663
|
100
|
66
|
|
|
44474
|
$self->{_overload_coderef} ||= $self->can_be_inlined |
275
|
|
|
|
|
|
|
? Eval::TypeTiny::eval_closure( |
276
|
|
|
|
|
|
|
source => sprintf( |
277
|
|
|
|
|
|
|
'sub { %s }', $self->inline_assert( '$_[0]', undef, no_wrapper => 1 ) |
278
|
|
|
|
|
|
|
), |
279
|
|
|
|
|
|
|
description => sprintf( "compiled assertion 'assert_%s'", $self ), |
280
|
|
|
|
|
|
|
) |
281
|
|
|
|
|
|
|
: Eval::TypeTiny::eval_closure( |
282
|
|
|
|
|
|
|
source => sprintf( |
283
|
|
|
|
|
|
|
'sub { %s }', $self->inline_assert( '$_[0]', '$type', no_wrapper => 1 ) |
284
|
|
|
|
|
|
|
), |
285
|
|
|
|
|
|
|
description => sprintf( "compiled assertion 'assert_%s'", $self ), |
286
|
|
|
|
|
|
|
environment => { '$type' => \$self }, |
287
|
|
|
|
|
|
|
); |
288
|
|
|
|
|
|
|
} #/ else [ if ( $self->{_overrides_assert_return...})] |
289
|
|
|
|
|
|
|
|
290
|
12826
|
|
|
|
|
80466
|
$self->{_overload_coderef}; |
291
|
|
|
|
|
|
|
} #/ sub _overload_coderef |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
our %ALL_TYPES; |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
my $QFS; |
296
|
|
|
|
|
|
|
my $uniq = 1; |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
sub new { |
299
|
93746
|
|
|
93746
|
1
|
170364
|
my $class = shift; |
300
|
93746
|
50
|
|
|
|
305072
|
my %params = ( @_ == 1 ) ? %{ $_[0] } : @_; |
|
0
|
|
|
|
|
0
|
|
301
|
|
|
|
|
|
|
|
302
|
93746
|
|
|
|
|
198351
|
for ( qw/ name display_name library / ) { |
303
|
281238
|
100
|
|
|
|
589538
|
$params{$_} = $params{$_} . '' if defined $params{$_}; |
304
|
|
|
|
|
|
|
} |
305
|
|
|
|
|
|
|
|
306
|
93746
|
|
|
|
|
147573
|
my $level = 0; |
307
|
93746
|
|
66
|
|
|
324216
|
while ( not exists $params{definition_context} and $level < 20 ) { |
308
|
229201
|
|
66
|
|
|
411497
|
our $_TT_GUTS ||= do { |
309
|
268
|
|
|
|
|
14658
|
my $g = join '|', map quotemeta, grep !m{^Types::}, @InternalPackages; |
310
|
268
|
|
|
|
|
130217
|
qr/\A(?:$g)\z/o |
311
|
|
|
|
|
|
|
}; |
312
|
229201
|
|
|
|
|
387796
|
my $package = caller $level; |
313
|
229201
|
100
|
|
|
|
1122948
|
if ( $package !~ $_TT_GUTS ) { |
314
|
93746
|
|
|
|
|
476658
|
@{ $params{definition_context} = {} }{ qw/ package file line / } = caller $level; |
|
93746
|
|
|
|
|
377645
|
|
315
|
|
|
|
|
|
|
} |
316
|
229201
|
|
|
|
|
692014
|
++$level; |
317
|
|
|
|
|
|
|
} |
318
|
|
|
|
|
|
|
|
319
|
93746
|
100
|
|
|
|
181058
|
if ( exists $params{parent} ) { |
320
|
|
|
|
|
|
|
$params{parent} = |
321
|
|
|
|
|
|
|
ref( $params{parent} ) =~ /^Type::Tiny\b/ |
322
|
|
|
|
|
|
|
? $params{parent} |
323
|
11257
|
50
|
|
|
|
43892
|
: Types::TypeTiny::to_TypeTiny( $params{parent} ); |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
_croak "Parent must be an instance of %s", __PACKAGE__ |
326
|
|
|
|
|
|
|
unless blessed( $params{parent} ) |
327
|
11257
|
50
|
33
|
|
|
52242
|
&& $params{parent}->isa( __PACKAGE__ ); |
328
|
|
|
|
|
|
|
|
329
|
11257
|
100
|
100
|
|
|
31731
|
if ( $params{parent}->deprecated and not exists $params{deprecated} ) { |
330
|
3
|
|
|
|
|
8
|
$params{deprecated} = 1; |
331
|
|
|
|
|
|
|
} |
332
|
|
|
|
|
|
|
} #/ if ( exists $params{parent...}) |
333
|
|
|
|
|
|
|
|
334
|
93746
|
100
|
66
|
|
|
338291
|
if ( exists $params{constraint} |
|
|
|
100
|
|
|
|
|
335
|
|
|
|
|
|
|
and defined $params{constraint} |
336
|
|
|
|
|
|
|
and not ref $params{constraint} ) |
337
|
|
|
|
|
|
|
{ |
338
|
79
|
|
|
|
|
436
|
require Eval::TypeTiny; |
339
|
79
|
|
|
|
|
195
|
my $code = $params{constraint}; |
340
|
79
|
|
|
|
|
496
|
$params{constraint} = Eval::TypeTiny::eval_closure( |
341
|
|
|
|
|
|
|
source => sprintf( 'sub ($) { %s }', $code ), |
342
|
|
|
|
|
|
|
description => "anonymous check", |
343
|
|
|
|
|
|
|
); |
344
|
|
|
|
|
|
|
$params{inlined} ||= sub { |
345
|
269
|
|
|
269
|
|
577
|
my ( $type ) = @_; |
346
|
269
|
100
|
|
|
|
1078
|
my $inlined = $_ eq '$_' ? "do { $code }" : "do { local \$_ = $_; $code }"; |
347
|
269
|
100
|
|
|
|
495
|
$type->has_parent ? ( undef, $inlined ) : $inlined; |
348
|
|
|
|
|
|
|
} |
349
|
79
|
50
|
50
|
|
|
541
|
if ( !exists $params{parent} or $params{parent}->can_be_inlined ); |
|
|
|
66
|
|
|
|
|
350
|
|
|
|
|
|
|
} #/ if ( exists $params{constraint...}) |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
# canonicalize to a boolean |
353
|
93746
|
|
|
|
|
183797
|
$params{deprecated} = !!$params{deprecated}; |
354
|
|
|
|
|
|
|
|
355
|
93746
|
100
|
|
|
|
214411
|
$params{name} = "__ANON__" unless exists $params{name}; |
356
|
93746
|
|
|
|
|
164652
|
$params{uniq} = $uniq++; |
357
|
|
|
|
|
|
|
|
358
|
93746
|
100
|
|
|
|
206180
|
if ( $params{name} ne "__ANON__" ) { |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
# First try a fast ASCII-only expression, but fall back to Unicode |
361
|
|
|
|
|
|
|
$params{name} =~ /^_{0,2}[A-Z][A-Za-z0-9_]+$/sm |
362
|
|
|
|
|
|
|
or eval q( use 5.008; $params{name} =~ /^_{0,2}\p{Lu}[\p{L}0-9_]+$/sm ) |
363
|
11667
|
100
|
66
|
|
|
58504
|
or _croak '"%s" is not a valid type name', $params{name}; |
|
1
|
|
|
|
|
28
|
|
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
732
|
|
|
1
|
|
|
|
|
30
|
|
|
1
|
|
|
|
|
15
|
|
364
|
|
|
|
|
|
|
} |
365
|
|
|
|
|
|
|
|
366
|
93745
|
100
|
100
|
|
|
213789
|
if ( exists $params{coercion} and !ref $params{coercion} and $params{coercion} ) |
|
|
|
100
|
|
|
|
|
367
|
|
|
|
|
|
|
{ |
368
|
|
|
|
|
|
|
$params{parent}->has_coercion |
369
|
2
|
50
|
|
|
|
10
|
or _croak |
370
|
|
|
|
|
|
|
"coercion => 1 requires type to have a direct parent with a coercion"; |
371
|
|
|
|
|
|
|
|
372
|
2
|
|
|
|
|
9
|
$params{coercion} = $params{parent}->coercion->type_coercion_map; |
373
|
|
|
|
|
|
|
} |
374
|
|
|
|
|
|
|
|
375
|
93745
|
100
|
100
|
|
|
526152
|
if ( !exists $params{inlined} |
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
376
|
|
|
|
|
|
|
and exists $params{constraint} |
377
|
|
|
|
|
|
|
and ( !exists $params{parent} or $params{parent}->can_be_inlined ) |
378
|
|
|
|
|
|
|
and $QFS ||= "Sub::Quote"->can( "quoted_from_sub" ) ) |
379
|
|
|
|
|
|
|
{ |
380
|
6
|
100
|
|
|
|
10
|
my ( undef, $perlstring, $captures ) = @{ $QFS->( $params{constraint} ) || [] }; |
|
6
|
|
|
|
|
22
|
|
381
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
$params{inlined} = sub { |
383
|
28
|
|
|
28
|
|
53
|
my ( $self, $var ) = @_; |
384
|
28
|
50
|
|
|
|
136
|
my $code = Sub::Quote::inlinify( |
385
|
|
|
|
|
|
|
$perlstring, |
386
|
|
|
|
|
|
|
$var, |
387
|
|
|
|
|
|
|
$var eq q($_) ? '' : "local \$_ = $var;", |
388
|
|
|
|
|
|
|
1, |
389
|
|
|
|
|
|
|
); |
390
|
28
|
100
|
|
|
|
588
|
$code = sprintf( '%s and %s', $self->parent->inline_check( $var ), $code ) |
391
|
|
|
|
|
|
|
if $self->has_parent; |
392
|
28
|
|
|
|
|
68
|
return $code; |
393
|
|
|
|
|
|
|
} |
394
|
6
|
100
|
100
|
|
|
359
|
if $perlstring && !$captures; |
395
|
|
|
|
|
|
|
} #/ if ( !exists $params{inlined...}) |
396
|
|
|
|
|
|
|
|
397
|
93745
|
|
|
|
|
190639
|
my $self = bless \%params, $class; |
398
|
|
|
|
|
|
|
|
399
|
93745
|
100
|
|
|
|
195570
|
unless ( $params{tmp} ) { |
400
|
93687
|
|
|
|
|
212976
|
my $uniq = $self->{uniq}; |
401
|
|
|
|
|
|
|
|
402
|
93687
|
|
|
|
|
295975
|
$ALL_TYPES{$uniq} = $self; |
403
|
93687
|
|
|
|
|
303102
|
Scalar::Util::weaken( $ALL_TYPES{$uniq} ); |
404
|
|
|
|
|
|
|
|
405
|
93687
|
|
|
|
|
136710
|
my $tmp = $self; |
406
|
93687
|
|
|
|
|
209508
|
Scalar::Util::weaken( $tmp ); |
407
|
93687
|
|
|
0
|
|
356683
|
$Moo::HandleMoose::TYPE_MAP{ $self->_stringify_no_magic } = sub { $tmp }; |
|
0
|
|
|
|
|
0
|
|
408
|
|
|
|
|
|
|
} #/ unless ( $params{tmp} ) |
409
|
|
|
|
|
|
|
|
410
|
93745
|
100
|
|
|
|
341735
|
if ( ref( $params{coercion} ) eq q(CODE) ) { |
|
|
100
|
|
|
|
|
|
411
|
2
|
|
|
|
|
12
|
require Types::Standard; |
412
|
2
|
|
|
|
|
6
|
my $code = delete( $params{coercion} ); |
413
|
2
|
|
|
|
|
8
|
$self->{coercion} = $self->_build_coercion; |
414
|
2
|
|
|
|
|
9
|
$self->coercion->add_type_coercions( Types::Standard::Any(), $code ); |
415
|
|
|
|
|
|
|
} |
416
|
|
|
|
|
|
|
elsif ( ref( $params{coercion} ) eq q(ARRAY) ) { |
417
|
5
|
|
|
|
|
19
|
my $arr = delete( $params{coercion} ); |
418
|
5
|
|
|
|
|
23
|
$self->{coercion} = $self->_build_coercion; |
419
|
5
|
|
|
|
|
26
|
$self->coercion->add_type_coercions( @$arr ); |
420
|
|
|
|
|
|
|
} |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
# Documenting this here because it's too weird to be in the pod. |
423
|
|
|
|
|
|
|
# There's a secret attribute called "_build_coercion" which takes a |
424
|
|
|
|
|
|
|
# coderef. If present, then when $type->coercion is lazy built, |
425
|
|
|
|
|
|
|
# the blank Type::Coercion object gets passed to the coderef, |
426
|
|
|
|
|
|
|
# allowing the coderef to manipulate it a little. This is used by |
427
|
|
|
|
|
|
|
# Types::TypeTiny to allow it to build a coercion for the TypeTiny |
428
|
|
|
|
|
|
|
# type constraint without needing to load Type::Coercion yet. |
429
|
|
|
|
|
|
|
|
430
|
93745
|
100
|
|
|
|
215841
|
if ( $params{my_methods} ) { |
431
|
1013
|
|
|
|
|
5752
|
require Eval::TypeTiny; |
432
|
|
|
|
|
|
|
Scalar::Util::reftype( $params{my_methods}{$_} ) eq 'CODE' |
433
|
|
|
|
|
|
|
and Eval::TypeTiny::set_subname( |
434
|
|
|
|
|
|
|
sprintf( "%s::my_%s", $self->qualified_name, $_ ), |
435
|
|
|
|
|
|
|
$params{my_methods}{$_}, |
436
|
1013
|
|
66
|
|
|
2071
|
) for keys %{ $params{my_methods} }; |
|
1013
|
|
|
|
|
9138
|
|
437
|
|
|
|
|
|
|
} #/ if ( $params{my_methods...}) |
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
# In general, mutating a type constraint after it's been created |
440
|
|
|
|
|
|
|
# is a bad idea and will probably not work. However some places are |
441
|
|
|
|
|
|
|
# especially harmful and can lead to confusing errors, so allow |
442
|
|
|
|
|
|
|
# subclasses to lock down particular keys. |
443
|
|
|
|
|
|
|
# |
444
|
|
|
|
|
|
|
$self->_lockdown( sub { |
445
|
40359
|
|
|
40359
|
|
159391
|
&Internals::SvREADONLY( $_, !!1 ) for @_; |
446
|
93745
|
|
|
|
|
406601
|
} ); |
447
|
|
|
|
|
|
|
|
448
|
93745
|
|
|
|
|
591280
|
return $self; |
449
|
|
|
|
|
|
|
} #/ sub new |
450
|
|
|
|
|
|
|
|
451
|
|
|
|
53386
|
|
|
sub _lockdown {} |
452
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
sub DESTROY { |
454
|
81506
|
|
|
81506
|
|
291000
|
my $self = shift; |
455
|
81506
|
|
|
|
|
234504
|
delete( $ALL_TYPES{ $self->{uniq} } ); |
456
|
81506
|
|
|
|
|
170227
|
delete( $Moo::HandleMoose::TYPE_MAP{ $self->_stringify_no_magic } ); |
457
|
81506
|
|
|
|
|
834690
|
return; |
458
|
|
|
|
|
|
|
} |
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
sub _clone { |
461
|
96
|
|
|
96
|
|
211
|
my $self = shift; |
462
|
96
|
|
|
|
|
188
|
my %opts; |
463
|
96
|
|
|
|
|
1016
|
$opts{$_} = $self->{$_} for qw< name display_name message >; |
464
|
96
|
|
|
|
|
482
|
$self->create_child_type( %opts ); |
465
|
|
|
|
|
|
|
} |
466
|
|
|
|
|
|
|
|
467
|
|
|
|
|
|
|
sub _stringify_no_magic { |
468
|
175194
|
|
|
175194
|
|
1269596
|
sprintf( |
469
|
|
|
|
|
|
|
'%s=%s(0x%08x)', blessed( $_[0] ), Scalar::Util::reftype( $_[0] ), |
470
|
|
|
|
|
|
|
Scalar::Util::refaddr( $_[0] ) |
471
|
|
|
|
|
|
|
); |
472
|
|
|
|
|
|
|
} |
473
|
|
|
|
|
|
|
|
474
|
|
|
|
|
|
|
our $DD; |
475
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
sub _dd { |
477
|
2517
|
50
|
|
2517
|
|
6217
|
@_ = $_ unless @_; |
478
|
2517
|
|
|
|
|
4636
|
my ( $value ) = @_; |
479
|
|
|
|
|
|
|
|
480
|
2517
|
100
|
|
|
|
6531
|
goto $DD if ref( $DD ) eq q(CODE); |
481
|
|
|
|
|
|
|
|
482
|
2515
|
|
|
|
|
10608
|
require B; |
483
|
|
|
|
|
|
|
|
484
|
|
|
|
|
|
|
!defined $value ? 'Undef' |
485
|
|
|
|
|
|
|
: !ref $value ? sprintf( 'Value %s', B::perlstring( $value ) ) |
486
|
2515
|
100
|
|
|
|
20172
|
: do { |
|
|
100
|
|
|
|
|
|
487
|
1497
|
50
|
|
|
|
3452
|
my $N = 0+ ( defined( $DD ) ? $DD : 72 ); |
488
|
1497
|
|
|
|
|
68508
|
require Data::Dumper; |
489
|
1497
|
|
|
|
|
619564
|
local $Data::Dumper::Indent = 0; |
490
|
1497
|
|
|
|
|
2328
|
local $Data::Dumper::Useqq = 1; |
491
|
1497
|
|
|
|
|
2314
|
local $Data::Dumper::Terse = 1; |
492
|
1497
|
|
|
|
|
2820
|
local $Data::Dumper::Sortkeys = 1; |
493
|
1497
|
|
|
|
|
2344
|
local $Data::Dumper::Maxdepth = 2; |
494
|
1497
|
|
|
|
|
2296
|
my $str; |
495
|
|
|
|
|
|
|
eval { |
496
|
1497
|
|
|
|
|
4306
|
$str = Data::Dumper::Dumper( $value ); |
497
|
1497
|
100
|
|
|
|
82618
|
$str = substr( $str, 0, $N - 12 ) . '...' . substr( $str, -1, 1 ) |
498
|
|
|
|
|
|
|
if length( $str ) >= $N; |
499
|
1497
|
|
|
|
|
4223
|
1; |
500
|
1497
|
50
|
|
|
|
2500
|
} or do { $str = 'which cannot be dumped' }; |
|
0
|
|
|
|
|
0
|
|
501
|
1497
|
|
|
|
|
14622
|
"Reference $str"; |
502
|
|
|
|
|
|
|
} #/ do |
503
|
|
|
|
|
|
|
} #/ sub _dd |
504
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
sub _loose_to_TypeTiny { |
506
|
29360
|
|
|
29360
|
|
45631
|
my $caller = caller( 1 ); # assumption |
507
|
|
|
|
|
|
|
map +( |
508
|
|
|
|
|
|
|
ref( $_ ) |
509
|
|
|
|
|
|
|
? Types::TypeTiny::to_TypeTiny( $_ ) |
510
|
29360
|
100
|
|
|
|
74895
|
: do { require Type::Utils; Type::Utils::dwim_type( $_, for => $caller ) } |
|
2
|
|
|
|
|
612
|
|
|
2
|
|
|
|
|
8
|
|
511
|
|
|
|
|
|
|
), @_; |
512
|
|
|
|
|
|
|
} |
513
|
|
|
|
|
|
|
|
514
|
93835
|
|
|
93835
|
1
|
450112
|
sub name { $_[0]{name} } |
515
|
46457
|
|
66
|
46457
|
1
|
233269
|
sub display_name { $_[0]{display_name} ||= $_[0]->_build_display_name } |
516
|
148634
|
|
|
148634
|
1
|
289814
|
sub parent { $_[0]{parent} } |
517
|
416286
|
|
66
|
416286
|
1
|
1482398
|
sub constraint { $_[0]{constraint} ||= $_[0]->_build_constraint } |
518
|
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
sub compiled_check { |
520
|
128716
|
|
66
|
128716
|
1
|
496392
|
$_[0]{compiled_type_constraint} ||= $_[0]->_build_compiled_check; |
521
|
|
|
|
|
|
|
} |
522
|
17107
|
|
66
|
17107
|
1
|
63808
|
sub coercion { $_[0]{coercion} ||= $_[0]->_build_coercion } |
523
|
28
|
|
|
28
|
1
|
92
|
sub message { $_[0]{message} } |
524
|
68
|
|
|
68
|
1
|
1058
|
sub library { $_[0]{library} } |
525
|
46439
|
|
|
46439
|
1
|
132576
|
sub inlined { $_[0]{inlined} } |
526
|
29052
|
|
|
29052
|
1
|
112418
|
sub deprecated { $_[0]{deprecated} } |
527
|
1004
|
|
|
1004
|
1
|
7657
|
sub constraint_generator { $_[0]{constraint_generator} } |
528
|
1060
|
|
|
1060
|
1
|
4047
|
sub inline_generator { $_[0]{inline_generator} } |
529
|
872
|
|
66
|
872
|
1
|
4576
|
sub name_generator { $_[0]{name_generator} ||= $_[0]->_build_name_generator } |
530
|
191
|
|
|
191
|
1
|
830
|
sub coercion_generator { $_[0]{coercion_generator} } |
531
|
914
|
|
|
914
|
1
|
5536
|
sub parameters { $_[0]{parameters} } |
532
|
0
|
|
0
|
0
|
1
|
0
|
sub moose_type { $_[0]{moose_type} ||= $_[0]->_build_moose_type } |
533
|
0
|
|
0
|
0
|
1
|
0
|
sub mouse_type { $_[0]{mouse_type} ||= $_[0]->_build_mouse_type } |
534
|
101
|
|
|
101
|
1
|
405
|
sub deep_explanation { $_[0]{deep_explanation} } |
535
|
1892
|
|
66
|
1892
|
1
|
6674
|
sub my_methods { $_[0]{my_methods} ||= $_[0]->_build_my_methods } |
536
|
25
|
|
|
25
|
1
|
55
|
sub sorter { $_[0]{sorter} } |
537
|
21624
|
|
66
|
21624
|
1
|
89630
|
sub exception_class { $_[0]{exception_class} ||= $_[0]->_build_exception_class } |
538
|
|
|
|
|
|
|
|
539
|
551533
|
|
|
551533
|
1
|
1387545
|
sub has_parent { exists $_[0]{parent} } |
540
|
0
|
|
|
0
|
1
|
0
|
sub has_library { exists $_[0]{library} } |
541
|
135052
|
|
|
135052
|
1
|
443731
|
sub has_inlined { exists $_[0]{inlined} } |
542
|
13661
|
|
|
13661
|
1
|
67289
|
sub has_constraint_generator { exists $_[0]{constraint_generator} } |
543
|
795
|
|
|
795
|
1
|
3448
|
sub has_inline_generator { exists $_[0]{inline_generator} } |
544
|
1758
|
|
|
1758
|
1
|
6412
|
sub has_coercion_generator { exists $_[0]{coercion_generator} } |
545
|
492
|
|
|
492
|
1
|
2076
|
sub has_parameters { exists $_[0]{parameters} } |
546
|
891
|
|
|
891
|
1
|
3683
|
sub has_message { defined $_[0]{message} } |
547
|
101
|
|
|
101
|
1
|
462
|
sub has_deep_explanation { exists $_[0]{deep_explanation} } |
548
|
74
|
|
|
74
|
1
|
187
|
sub has_sorter { exists $_[0]{sorter} } |
549
|
|
|
|
|
|
|
|
550
|
|
|
|
|
|
|
sub _default_message { |
551
|
863
|
|
66
|
863
|
|
3280
|
$_[0]{_default_message} ||= $_[0]->_build_default_message; |
552
|
|
|
|
|
|
|
} |
553
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
sub has_coercion { |
555
|
26958
|
100
|
|
26958
|
1
|
66360
|
$_[0]->coercion if $_[0]{_build_coercion}; # trigger auto build thing |
556
|
26958
|
100
|
|
|
|
114491
|
$_[0]{coercion} and !!@{ $_[0]{coercion}->type_coercion_map }; |
|
16292
|
|
|
|
|
34877
|
|
557
|
|
|
|
|
|
|
} |
558
|
|
|
|
|
|
|
|
559
|
|
|
|
|
|
|
sub _assert_coercion { |
560
|
639
|
|
|
639
|
|
1155
|
my $self = shift; |
561
|
639
|
100
|
|
|
|
2160
|
return $self->coercion if $self->{_build_coercion}; # trigger auto build thing |
562
|
|
|
|
|
|
|
_croak "No coercion for this type constraint" |
563
|
|
|
|
|
|
|
unless $self->has_coercion |
564
|
503
|
100
|
66
|
|
|
1065
|
&& @{ $self->coercion->type_coercion_map }; |
|
494
|
|
|
|
|
1108
|
|
565
|
494
|
|
|
|
|
1143
|
$self->coercion; |
566
|
|
|
|
|
|
|
} |
567
|
|
|
|
|
|
|
|
568
|
|
|
|
|
|
|
my $null_constraint = sub { !!1 }; |
569
|
|
|
|
|
|
|
|
570
|
|
|
|
|
|
|
sub _build_display_name { |
571
|
11497
|
|
|
11497
|
|
23420
|
shift->name; |
572
|
|
|
|
|
|
|
} |
573
|
|
|
|
|
|
|
|
574
|
|
|
|
|
|
|
sub _build_constraint { |
575
|
4155
|
|
|
4155
|
|
24084
|
return $null_constraint; |
576
|
|
|
|
|
|
|
} |
577
|
|
|
|
|
|
|
|
578
|
|
|
|
|
|
|
sub _is_null_constraint { |
579
|
356912
|
|
|
356912
|
|
552046
|
shift->constraint == $null_constraint; |
580
|
|
|
|
|
|
|
} |
581
|
|
|
|
|
|
|
|
582
|
|
|
|
|
|
|
sub _build_coercion { |
583
|
11216
|
|
|
11216
|
|
163909
|
require Type::Coercion; |
584
|
11216
|
|
|
|
|
17454
|
my $self = shift; |
585
|
11216
|
|
|
|
|
22308
|
my %opts = ( type_constraint => $self ); |
586
|
11216
|
100
|
|
|
|
20402
|
$opts{display_name} = "to_$self" unless $self->is_anon; |
587
|
11216
|
|
|
|
|
41788
|
my $coercion = "Type::Coercion"->new( %opts ); |
588
|
11216
|
100
|
|
|
|
26660
|
$self->{_build_coercion}->( $coercion ) if ref $self->{_build_coercion}; |
589
|
11216
|
|
|
|
|
33655
|
$coercion; |
590
|
|
|
|
|
|
|
} |
591
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
sub _build_default_message { |
593
|
178
|
|
|
178
|
|
344
|
my $self = shift; |
594
|
178
|
|
|
|
|
786
|
$self->{is_using_default_message} = 1; |
595
|
66
|
|
|
66
|
|
199
|
return sub { sprintf '%s did not pass type constraint', _dd( $_[0] ) } |
596
|
178
|
100
|
|
|
|
510
|
if "$self" eq "__ANON__"; |
597
|
153
|
|
|
|
|
416
|
my $name = "$self"; |
598
|
|
|
|
|
|
|
return sub { |
599
|
794
|
|
|
794
|
|
1935
|
sprintf '%s did not pass type constraint "%s"', _dd( $_[0] ), $name; |
600
|
153
|
|
|
|
|
1134
|
}; |
601
|
|
|
|
|
|
|
} #/ sub _build_default_message |
602
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
sub _build_name_generator { |
604
|
210
|
|
|
210
|
|
593
|
my $self = shift; |
605
|
|
|
|
|
|
|
return sub { |
606
|
723
|
|
33
|
723
|
|
4811
|
defined && s/[\x00-\x1F]//smg for ( my ( $s, @a ) = @_ ); |
607
|
723
|
100
|
100
|
|
|
7427
|
sprintf( '%s[%s]', $s, join q[,], map !defined() ? 'undef' : !ref() && /\W/ ? B::perlstring($_) : $_, @a ); |
|
|
50
|
|
|
|
|
|
608
|
210
|
|
|
|
|
1670
|
}; |
609
|
|
|
|
|
|
|
} |
610
|
|
|
|
|
|
|
|
611
|
|
|
|
|
|
|
sub _build_compiled_check { |
612
|
47157
|
|
|
47157
|
|
81218
|
my $self = shift; |
613
|
|
|
|
|
|
|
|
614
|
47157
|
|
|
|
|
77746
|
local our $AvoidCallbacks = 0; |
615
|
|
|
|
|
|
|
|
616
|
47157
|
100
|
100
|
|
|
85762
|
if ( $self->_is_null_constraint and $self->has_parent ) { |
617
|
3134
|
|
|
|
|
7014
|
return $self->parent->compiled_check; |
618
|
|
|
|
|
|
|
} |
619
|
|
|
|
|
|
|
|
620
|
44023
|
|
|
|
|
209925
|
require Eval::TypeTiny; |
621
|
44023
|
100
|
|
|
|
110606
|
return Eval::TypeTiny::eval_closure( |
622
|
|
|
|
|
|
|
source => sprintf( 'sub ($) { %s }', $self->inline_check( '$_[0]' ) ), |
623
|
|
|
|
|
|
|
description => sprintf( "compiled check '%s'", $self ), |
624
|
|
|
|
|
|
|
) if $self->can_be_inlined; |
625
|
|
|
|
|
|
|
|
626
|
40258
|
|
|
|
|
67238
|
my @constraints; |
627
|
40258
|
100
|
|
|
|
64791
|
push @constraints, $self->parent->compiled_check if $self->has_parent; |
628
|
40258
|
50
|
|
|
|
72529
|
push @constraints, $self->constraint if !$self->_is_null_constraint; |
629
|
40258
|
50
|
|
|
|
101826
|
return $null_constraint unless @constraints; |
630
|
|
|
|
|
|
|
|
631
|
|
|
|
|
|
|
return sub ($) { |
632
|
3480
|
|
|
3480
|
|
83064
|
local $_ = $_[0]; |
|
|
|
|
576
|
|
|
|
|
|
|
|
575
|
|
|
|
|
|
|
|
558
|
|
|
|
|
|
|
|
572
|
|
|
|
633
|
3480
|
|
|
|
|
5169
|
for my $c ( @constraints ) { |
634
|
5910
|
100
|
|
|
|
14823
|
return unless $c->( @_ ); |
635
|
|
|
|
|
|
|
} |
636
|
2312
|
|
|
|
|
12267
|
return !!1; |
637
|
40258
|
|
|
|
|
224148
|
}; |
638
|
|
|
|
|
|
|
} #/ sub _build_compiled_check |
639
|
|
|
|
|
|
|
|
640
|
|
|
|
|
|
|
sub _build_exception_class { |
641
|
11153
|
|
|
11153
|
|
15829
|
my $self = shift; |
642
|
11153
|
100
|
|
|
|
17679
|
return $self->parent->exception_class if $self->has_parent; |
643
|
947
|
|
|
|
|
103383
|
require Error::TypeTiny::Assertion; |
644
|
947
|
|
|
|
|
4663
|
return 'Error::TypeTiny::Assertion'; |
645
|
|
|
|
|
|
|
} |
646
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
sub definition_context { |
648
|
1
|
|
|
1
|
1
|
2
|
my $self = shift; |
649
|
|
|
|
|
|
|
my $found = $self->find_parent(sub { |
650
|
1
|
50
|
|
1
|
|
9
|
ref $_->{definition_context} and exists $_->{definition_context}{file}; |
651
|
1
|
|
|
|
|
6
|
}); |
652
|
1
|
50
|
|
|
|
4
|
$found ? $found->{definition_context} : {}; |
653
|
|
|
|
|
|
|
} |
654
|
|
|
|
|
|
|
|
655
|
|
|
|
|
|
|
sub find_constraining_type { |
656
|
3769
|
|
|
3769
|
1
|
4668
|
my $self = shift; |
657
|
3769
|
100
|
100
|
|
|
5533
|
if ( $self->_is_null_constraint and $self->has_parent ) { |
658
|
736
|
|
|
|
|
1404
|
return $self->parent->find_constraining_type; |
659
|
|
|
|
|
|
|
} |
660
|
3033
|
|
|
|
|
5747
|
$self; |
661
|
|
|
|
|
|
|
} |
662
|
|
|
|
|
|
|
|
663
|
|
|
|
|
|
|
sub type_default { |
664
|
559
|
|
|
559
|
1
|
6367
|
my ( $self, @args ) = @_; |
665
|
559
|
100
|
|
|
|
1938
|
if ( exists $self->{type_default} ) { |
666
|
417
|
100
|
|
|
|
1227
|
if ( @args ) { |
667
|
1
|
|
|
|
|
3
|
my $td = $self->{type_default}; |
668
|
1
|
|
|
1
|
|
5
|
return sub { local $_ = \@args; &$td; }; |
|
1
|
|
|
|
|
813
|
|
|
1
|
|
|
|
|
4
|
|
669
|
|
|
|
|
|
|
} |
670
|
416
|
|
|
|
|
2173
|
return $self->{type_default}; |
671
|
|
|
|
|
|
|
} |
672
|
142
|
100
|
|
|
|
482
|
if ( my $parent = $self->parent ) { |
673
|
140
|
100
|
|
|
|
423
|
return $parent->type_default( @args ) if $self->_is_null_constraint; |
674
|
|
|
|
|
|
|
} |
675
|
59
|
|
|
|
|
432
|
return undef; |
676
|
|
|
|
|
|
|
} |
677
|
|
|
|
|
|
|
|
678
|
|
|
|
|
|
|
our @CMP; |
679
|
|
|
|
|
|
|
|
680
|
|
|
|
|
|
|
sub CMP_SUPERTYPE () { -1 } |
681
|
|
|
|
|
|
|
sub CMP_EQUAL () { 0 } |
682
|
|
|
|
|
|
|
sub CMP_EQUIVALENT () { '0E0' } |
683
|
|
|
|
|
|
|
sub CMP_SUBTYPE () { 1 } |
684
|
|
|
|
|
|
|
sub CMP_UNKNOWN () { ''; } |
685
|
|
|
|
|
|
|
|
686
|
|
|
|
|
|
|
# avoid getting mixed up with cmp operator at compile time |
687
|
|
|
|
|
|
|
*cmp = sub { |
688
|
1477
|
|
|
1477
|
|
17401
|
my ( $A, $B ) = _loose_to_TypeTiny( $_[0], $_[1] ); |
689
|
1477
|
50
|
33
|
|
|
7002
|
return unless blessed( $A ) && $A->isa( "Type::Tiny" ); |
690
|
1477
|
50
|
33
|
|
|
5686
|
return unless blessed( $B ) && $B->isa( "Type::Tiny" ); |
691
|
1477
|
|
|
|
|
3510
|
for my $comparator ( @CMP ) { |
692
|
1884
|
|
|
|
|
3951
|
my $result = $comparator->( $A, $B ); |
693
|
1884
|
100
|
|
|
|
4462
|
next if $result eq CMP_UNKNOWN; |
694
|
1152
|
100
|
|
|
|
2413
|
if ( $result eq CMP_EQUIVALENT ) { |
695
|
51
|
100
|
|
|
|
178
|
my $prefer = @_ == 3 ? $_[2] : CMP_EQUAL; |
696
|
51
|
|
|
|
|
167
|
return $prefer; |
697
|
|
|
|
|
|
|
} |
698
|
1101
|
|
|
|
|
2486
|
return $result; |
699
|
|
|
|
|
|
|
} |
700
|
325
|
|
|
|
|
657
|
return CMP_UNKNOWN; |
701
|
|
|
|
|
|
|
}; |
702
|
|
|
|
|
|
|
|
703
|
|
|
|
|
|
|
push @CMP, sub { |
704
|
|
|
|
|
|
|
my ( $A, $B ) = @_; |
705
|
|
|
|
|
|
|
return CMP_EQUAL |
706
|
|
|
|
|
|
|
if Scalar::Util::refaddr( $A ) == Scalar::Util::refaddr( $B ); |
707
|
|
|
|
|
|
|
|
708
|
|
|
|
|
|
|
return CMP_EQUIVALENT |
709
|
|
|
|
|
|
|
if Scalar::Util::refaddr( $A->compiled_check ) == |
710
|
|
|
|
|
|
|
Scalar::Util::refaddr( $B->compiled_check ); |
711
|
|
|
|
|
|
|
|
712
|
|
|
|
|
|
|
my $A_stem = $A->find_constraining_type; |
713
|
|
|
|
|
|
|
my $B_stem = $B->find_constraining_type; |
714
|
|
|
|
|
|
|
return CMP_EQUIVALENT |
715
|
|
|
|
|
|
|
if Scalar::Util::refaddr( $A_stem ) == Scalar::Util::refaddr( $B_stem ); |
716
|
|
|
|
|
|
|
return CMP_EQUIVALENT |
717
|
|
|
|
|
|
|
if Scalar::Util::refaddr( $A_stem->compiled_check ) == |
718
|
|
|
|
|
|
|
Scalar::Util::refaddr( $B_stem->compiled_check ); |
719
|
|
|
|
|
|
|
|
720
|
|
|
|
|
|
|
if ( $A_stem->can_be_inlined and $B_stem->can_be_inlined ) { |
721
|
|
|
|
|
|
|
return CMP_EQUIVALENT |
722
|
|
|
|
|
|
|
if $A_stem->inline_check( '$WOLFIE' ) eq $B_stem->inline_check( '$WOLFIE' ); |
723
|
|
|
|
|
|
|
} |
724
|
|
|
|
|
|
|
|
725
|
|
|
|
|
|
|
A_IS_SUBTYPE: { |
726
|
|
|
|
|
|
|
my $A_prime = $A_stem; |
727
|
|
|
|
|
|
|
while ( $A_prime->has_parent ) { |
728
|
|
|
|
|
|
|
$A_prime = $A_prime->parent; |
729
|
|
|
|
|
|
|
return CMP_SUBTYPE |
730
|
|
|
|
|
|
|
if Scalar::Util::refaddr( $A_prime ) == Scalar::Util::refaddr( $B_stem ); |
731
|
|
|
|
|
|
|
return CMP_SUBTYPE |
732
|
|
|
|
|
|
|
if Scalar::Util::refaddr( $A_prime->compiled_check ) == |
733
|
|
|
|
|
|
|
Scalar::Util::refaddr( $B_stem->compiled_check ); |
734
|
|
|
|
|
|
|
if ( $A_prime->can_be_inlined and $B_stem->can_be_inlined ) { |
735
|
|
|
|
|
|
|
return CMP_SUBTYPE |
736
|
|
|
|
|
|
|
if $A_prime->inline_check( '$WOLFIE' ) eq $B_stem->inline_check( '$WOLFIE' ); |
737
|
|
|
|
|
|
|
} |
738
|
|
|
|
|
|
|
} #/ while ( $A_prime->has_parent) |
739
|
|
|
|
|
|
|
} #/ A_IS_SUBTYPE: |
740
|
|
|
|
|
|
|
|
741
|
|
|
|
|
|
|
B_IS_SUBTYPE: { |
742
|
|
|
|
|
|
|
my $B_prime = $B_stem; |
743
|
|
|
|
|
|
|
while ( $B_prime->has_parent ) { |
744
|
|
|
|
|
|
|
$B_prime = $B_prime->parent; |
745
|
|
|
|
|
|
|
return CMP_SUPERTYPE |
746
|
|
|
|
|
|
|
if Scalar::Util::refaddr( $B_prime ) == Scalar::Util::refaddr( $A_stem ); |
747
|
|
|
|
|
|
|
return CMP_SUPERTYPE |
748
|
|
|
|
|
|
|
if Scalar::Util::refaddr( $B_prime->compiled_check ) == |
749
|
|
|
|
|
|
|
Scalar::Util::refaddr( $A_stem->compiled_check ); |
750
|
|
|
|
|
|
|
if ( $A_stem->can_be_inlined and $B_prime->can_be_inlined ) { |
751
|
|
|
|
|
|
|
return CMP_SUPERTYPE |
752
|
|
|
|
|
|
|
if $B_prime->inline_check( '$WOLFIE' ) eq $A_stem->inline_check( '$WOLFIE' ); |
753
|
|
|
|
|
|
|
} |
754
|
|
|
|
|
|
|
} #/ while ( $B_prime->has_parent) |
755
|
|
|
|
|
|
|
} #/ B_IS_SUBTYPE: |
756
|
|
|
|
|
|
|
|
757
|
|
|
|
|
|
|
return CMP_UNKNOWN; |
758
|
|
|
|
|
|
|
}; |
759
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
sub equals { |
761
|
761
|
|
|
761
|
1
|
2003
|
my $result = Type::Tiny::cmp( $_[0], $_[1] ); |
762
|
761
|
50
|
|
|
|
1617
|
return unless defined $result; |
763
|
761
|
|
|
|
|
3574
|
$result eq CMP_EQUAL; |
764
|
|
|
|
|
|
|
} |
765
|
|
|
|
|
|
|
|
766
|
|
|
|
|
|
|
sub is_subtype_of { |
767
|
101
|
|
|
101
|
1
|
298
|
my $result = Type::Tiny::cmp( $_[0], $_[1], CMP_SUBTYPE ); |
768
|
101
|
50
|
|
|
|
247
|
return unless defined $result; |
769
|
101
|
|
|
|
|
476
|
$result eq CMP_SUBTYPE; |
770
|
|
|
|
|
|
|
} |
771
|
|
|
|
|
|
|
|
772
|
|
|
|
|
|
|
sub is_supertype_of { |
773
|
19
|
|
|
19
|
1
|
487
|
my $result = Type::Tiny::cmp( $_[0], $_[1], CMP_SUBTYPE ); |
774
|
19
|
50
|
|
|
|
48
|
return unless defined $result; |
775
|
19
|
|
|
|
|
95
|
$result eq CMP_SUPERTYPE; |
776
|
|
|
|
|
|
|
} |
777
|
|
|
|
|
|
|
|
778
|
|
|
|
|
|
|
sub is_a_type_of { |
779
|
552
|
|
|
552
|
1
|
4704
|
my $result = Type::Tiny::cmp( $_[0], $_[1] ); |
780
|
552
|
50
|
|
|
|
1305
|
return unless defined $result; |
781
|
552
|
100
|
100
|
|
|
4703
|
$result eq CMP_SUBTYPE or $result eq CMP_EQUAL or $result eq CMP_EQUIVALENT; |
782
|
|
|
|
|
|
|
} |
783
|
|
|
|
|
|
|
|
784
|
|
|
|
|
|
|
sub strictly_equals { |
785
|
13040
|
|
|
13040
|
1
|
20502
|
my ( $self, $other ) = _loose_to_TypeTiny( @_ ); |
786
|
13040
|
50
|
33
|
|
|
40863
|
return unless blessed( $self ) && $self->isa( "Type::Tiny" ); |
787
|
13040
|
50
|
33
|
|
|
39340
|
return unless blessed( $other ) && $other->isa( "Type::Tiny" ); |
788
|
13040
|
|
|
|
|
50662
|
$self->{uniq} == $other->{uniq}; |
789
|
|
|
|
|
|
|
} |
790
|
|
|
|
|
|
|
|
791
|
|
|
|
|
|
|
sub is_strictly_subtype_of { |
792
|
12500
|
|
|
12500
|
1
|
20239
|
my ( $self, $other ) = _loose_to_TypeTiny( @_ ); |
793
|
12500
|
50
|
33
|
|
|
39421
|
return unless blessed( $self ) && $self->isa( "Type::Tiny" ); |
794
|
12500
|
50
|
33
|
|
|
38428
|
return unless blessed( $other ) && $other->isa( "Type::Tiny" ); |
795
|
|
|
|
|
|
|
|
796
|
12500
|
100
|
|
|
|
24551
|
return unless $self->has_parent; |
797
|
10682
|
100
|
|
|
|
18840
|
$self->parent->strictly_equals( $other ) |
798
|
|
|
|
|
|
|
or $self->parent->is_strictly_subtype_of( $other ); |
799
|
|
|
|
|
|
|
} |
800
|
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
sub is_strictly_supertype_of { |
802
|
2
|
|
|
2
|
1
|
13
|
my ( $self, $other ) = _loose_to_TypeTiny( @_ ); |
803
|
2
|
50
|
33
|
|
|
16
|
return unless blessed( $self ) && $self->isa( "Type::Tiny" ); |
804
|
2
|
50
|
33
|
|
|
12
|
return unless blessed( $other ) && $other->isa( "Type::Tiny" ); |
805
|
|
|
|
|
|
|
|
806
|
2
|
|
|
|
|
8
|
$other->is_strictly_subtype_of( $self ); |
807
|
|
|
|
|
|
|
} |
808
|
|
|
|
|
|
|
|
809
|
|
|
|
|
|
|
sub is_strictly_a_type_of { |
810
|
2341
|
|
|
2341
|
1
|
12057
|
my ( $self, $other ) = _loose_to_TypeTiny( @_ ); |
811
|
2341
|
50
|
33
|
|
|
9888
|
return unless blessed( $self ) && $self->isa( "Type::Tiny" ); |
812
|
2341
|
50
|
33
|
|
|
8412
|
return unless blessed( $other ) && $other->isa( "Type::Tiny" ); |
813
|
|
|
|
|
|
|
|
814
|
2341
|
50
|
|
|
|
6353
|
$self->strictly_equals( $other ) or $self->is_strictly_subtype_of( $other ); |
815
|
|
|
|
|
|
|
} |
816
|
|
|
|
|
|
|
|
817
|
|
|
|
|
|
|
sub qualified_name { |
818
|
12789
|
|
|
12789
|
1
|
18188
|
my $self = shift; |
819
|
|
|
|
|
|
|
( exists $self->{library} and $self->name ne "__ANON__" ) |
820
|
|
|
|
|
|
|
? "$self->{library}::$self->{name}" |
821
|
12789
|
100
|
66
|
|
|
35260
|
: $self->{name}; |
822
|
|
|
|
|
|
|
} |
823
|
|
|
|
|
|
|
|
824
|
|
|
|
|
|
|
sub is_anon { |
825
|
36442
|
|
|
36442
|
1
|
48040
|
my $self = shift; |
826
|
36442
|
|
|
|
|
59153
|
$self->name eq "__ANON__"; |
827
|
|
|
|
|
|
|
} |
828
|
|
|
|
|
|
|
|
829
|
|
|
|
|
|
|
sub parents { |
830
|
36257
|
|
|
36257
|
1
|
46317
|
my $self = shift; |
831
|
36257
|
100
|
|
|
|
55586
|
return unless $self->has_parent; |
832
|
30205
|
|
|
|
|
52943
|
return ( $self->parent, $self->parent->parents ); |
833
|
|
|
|
|
|
|
} |
834
|
|
|
|
|
|
|
|
835
|
|
|
|
|
|
|
sub find_parent { |
836
|
462
|
|
|
462
|
1
|
895
|
my $self = shift; |
837
|
462
|
|
|
|
|
940
|
my ( $test ) = @_; |
838
|
|
|
|
|
|
|
|
839
|
462
|
|
|
|
|
1583
|
local ( $_, $. ); |
840
|
462
|
|
|
|
|
733
|
my $type = $self; |
841
|
462
|
|
|
|
|
731
|
my $count = 0; |
842
|
462
|
|
|
|
|
1440
|
while ( $type ) { |
843
|
570
|
100
|
|
|
|
1898
|
if ( $test->( $_ = $type, $. = $count ) ) { |
844
|
459
|
100
|
|
|
|
2421
|
return wantarray ? ( $type, $count ) : $type; |
845
|
|
|
|
|
|
|
} |
846
|
|
|
|
|
|
|
else { |
847
|
111
|
|
|
|
|
217
|
$type = $type->parent; |
848
|
111
|
|
|
|
|
272
|
$count++; |
849
|
|
|
|
|
|
|
} |
850
|
|
|
|
|
|
|
} |
851
|
|
|
|
|
|
|
|
852
|
3
|
|
|
|
|
15
|
return; |
853
|
|
|
|
|
|
|
} #/ sub find_parent |
854
|
|
|
|
|
|
|
|
855
|
|
|
|
|
|
|
sub check { |
856
|
137288
|
|
|
137288
|
1
|
246088
|
my $self = shift; |
857
|
137288
|
|
66
|
|
|
653107
|
( $self->{compiled_type_constraint} ||= $self->_build_compiled_check )->( @_ ); |
858
|
|
|
|
|
|
|
} |
859
|
|
|
|
|
|
|
|
860
|
|
|
|
|
|
|
sub _strict_check { |
861
|
5330
|
|
|
5330
|
|
11370
|
my $self = shift; |
862
|
5330
|
|
|
|
|
10422
|
local $_ = $_[0]; |
863
|
|
|
|
|
|
|
|
864
|
|
|
|
|
|
|
my @constraints = |
865
|
|
|
|
|
|
|
reverse |
866
|
19247
|
|
|
|
|
30855
|
map { $_->constraint } |
867
|
5330
|
|
|
|
|
13822
|
grep { not $_->_is_null_constraint } ( $self, $self->parents ); |
|
31640
|
|
|
|
|
52340
|
|
868
|
|
|
|
|
|
|
|
869
|
5330
|
|
|
|
|
12317
|
for my $c ( @constraints ) { |
870
|
14772
|
100
|
|
|
|
45937
|
return unless $c->( @_ ); |
871
|
|
|
|
|
|
|
} |
872
|
|
|
|
|
|
|
|
873
|
1465
|
|
|
|
|
9470
|
return !!1; |
874
|
|
|
|
|
|
|
} #/ sub _strict_check |
875
|
|
|
|
|
|
|
|
876
|
|
|
|
|
|
|
sub get_message { |
877
|
891
|
|
|
891
|
1
|
1573
|
my $self = shift; |
878
|
891
|
|
|
|
|
1464
|
local $_ = $_[0]; |
879
|
891
|
100
|
|
|
|
2082
|
$self->has_message |
880
|
|
|
|
|
|
|
? $self->message->( @_ ) |
881
|
|
|
|
|
|
|
: $self->_default_message->( @_ ); |
882
|
|
|
|
|
|
|
} |
883
|
|
|
|
|
|
|
|
884
|
|
|
|
|
|
|
sub validate { |
885
|
2
|
|
|
2
|
1
|
3
|
my $self = shift; |
886
|
|
|
|
|
|
|
|
887
|
|
|
|
|
|
|
return undef |
888
|
2
|
50
|
33
|
|
|
11
|
if ( $self->{compiled_type_constraint} ||= $self->_build_compiled_check ) |
889
|
|
|
|
|
|
|
->( @_ ); |
890
|
|
|
|
|
|
|
|
891
|
2
|
|
|
|
|
22
|
local $_ = $_[0]; |
892
|
2
|
|
|
|
|
7
|
return $self->get_message( @_ ); |
893
|
|
|
|
|
|
|
} #/ sub validate |
894
|
|
|
|
|
|
|
|
895
|
|
|
|
|
|
|
sub validate_explain { |
896
|
2130
|
|
|
2130
|
1
|
4412
|
my $self = shift; |
897
|
2130
|
|
|
|
|
3507
|
my ( $value, $varname ) = @_; |
898
|
2130
|
100
|
|
|
|
3698
|
$varname = '$_' unless defined $varname; |
899
|
|
|
|
|
|
|
|
900
|
2130
|
100
|
|
|
|
3735
|
return undef if $self->check( $value ); |
901
|
|
|
|
|
|
|
|
902
|
1684
|
100
|
|
|
|
7220
|
if ( $self->has_parent ) { |
903
|
1676
|
|
|
|
|
2860
|
my $parent = $self->parent->validate_explain( $value, $varname ); |
904
|
|
|
|
|
|
|
return [ |
905
|
1676
|
100
|
|
|
|
4637
|
sprintf( '"%s" is a subtype of "%s"', $self, $self->parent ), |
906
|
|
|
|
|
|
|
@$parent |
907
|
|
|
|
|
|
|
] |
908
|
|
|
|
|
|
|
if $parent; |
909
|
|
|
|
|
|
|
} |
910
|
|
|
|
|
|
|
|
911
|
454
|
100
|
|
|
|
1210
|
my $message = sprintf( |
912
|
|
|
|
|
|
|
'%s%s', |
913
|
|
|
|
|
|
|
$self->get_message( $value ), |
914
|
|
|
|
|
|
|
$varname eq q{$_} ? '' : sprintf( ' (in %s)', $varname ), |
915
|
|
|
|
|
|
|
); |
916
|
|
|
|
|
|
|
|
917
|
454
|
100
|
66
|
|
|
1370
|
if ( $self->is_parameterized and $self->parent->has_deep_explanation ) { |
918
|
101
|
|
|
|
|
323
|
my $deep = $self->parent->deep_explanation->( $self, $value, $varname ); |
919
|
101
|
50
|
|
|
|
813
|
return [ $message, @$deep ] if $deep; |
920
|
|
|
|
|
|
|
} |
921
|
|
|
|
|
|
|
|
922
|
353
|
|
|
0
|
|
2468
|
local $SIG{__WARN__} = sub {}; |
923
|
|
|
|
|
|
|
return [ |
924
|
353
|
|
|
|
|
1064
|
$message, |
925
|
|
|
|
|
|
|
sprintf( '"%s" is defined as: %s', $self, $self->_perlcode ) |
926
|
|
|
|
|
|
|
]; |
927
|
|
|
|
|
|
|
} #/ sub validate_explain |
928
|
|
|
|
|
|
|
|
929
|
|
|
|
|
|
|
my $b; |
930
|
|
|
|
|
|
|
|
931
|
|
|
|
|
|
|
sub _perlcode { |
932
|
353
|
|
|
353
|
|
573
|
my $self = shift; |
933
|
|
|
|
|
|
|
|
934
|
353
|
|
|
|
|
642
|
local our $AvoidCallbacks = 1; |
935
|
353
|
100
|
|
|
|
883
|
return $self->inline_check( '$_' ) |
936
|
|
|
|
|
|
|
if $self->can_be_inlined; |
937
|
|
|
|
|
|
|
|
938
|
12
|
|
66
|
|
|
77
|
$b ||= do { |
939
|
7
|
|
|
|
|
27
|
local $@; |
940
|
7
|
|
|
|
|
47
|
require B::Deparse; |
941
|
7
|
|
|
|
|
413
|
my $tmp = "B::Deparse"->new; |
942
|
7
|
50
|
|
|
|
558
|
$tmp->ambient_pragmas( strict => "all", warnings => "all" ) |
943
|
|
|
|
|
|
|
if $tmp->can( 'ambient_pragmas' ); |
944
|
7
|
|
|
|
|
42
|
$tmp; |
945
|
|
|
|
|
|
|
}; |
946
|
|
|
|
|
|
|
|
947
|
12
|
|
|
|
|
42
|
my $code = $b->coderef2text( $self->constraint ); |
948
|
12
|
|
|
|
|
127
|
$code =~ s/\s+/ /g; |
949
|
12
|
|
|
|
|
81
|
return "sub $code"; |
950
|
|
|
|
|
|
|
} #/ sub _perlcode |
951
|
|
|
|
|
|
|
|
952
|
|
|
|
|
|
|
sub assert_valid { |
953
|
85
|
|
|
85
|
1
|
5456
|
my $self = shift; |
954
|
|
|
|
|
|
|
|
955
|
|
|
|
|
|
|
return !!1 |
956
|
85
|
100
|
66
|
|
|
497
|
if ( $self->{compiled_type_constraint} ||= $self->_build_compiled_check ) |
957
|
|
|
|
|
|
|
->( @_ ); |
958
|
|
|
|
|
|
|
|
959
|
15
|
|
|
|
|
135
|
local $_ = $_[0]; |
960
|
15
|
|
|
|
|
64
|
$self->_failed_check( "$self", $_ ); |
961
|
|
|
|
|
|
|
} #/ sub assert_valid |
962
|
|
|
|
|
|
|
|
963
|
|
|
|
|
|
|
sub assert_return { |
964
|
115083
|
|
|
115083
|
1
|
174453
|
my $self = shift; |
965
|
|
|
|
|
|
|
|
966
|
|
|
|
|
|
|
return $_[0] |
967
|
115083
|
100
|
66
|
|
|
352157
|
if ( $self->{compiled_type_constraint} ||= $self->_build_compiled_check ) |
968
|
|
|
|
|
|
|
->( @_ ); |
969
|
|
|
|
|
|
|
|
970
|
1
|
|
|
|
|
9
|
local $_ = $_[0]; |
971
|
1
|
|
|
|
|
4
|
$self->_failed_check( "$self", $_ ); |
972
|
|
|
|
|
|
|
} #/ sub assert_return |
973
|
|
|
|
|
|
|
|
974
|
|
|
|
|
|
|
sub can_be_inlined { |
975
|
175310
|
|
|
175310
|
1
|
234824
|
my $self = shift; |
976
|
175310
|
100
|
100
|
|
|
276742
|
return $self->parent->can_be_inlined |
977
|
|
|
|
|
|
|
if $self->has_parent && $self->_is_null_constraint; |
978
|
149708
|
100
|
100
|
|
|
275307
|
return !!1 |
979
|
|
|
|
|
|
|
if !$self->has_parent && $self->_is_null_constraint; |
980
|
137427
|
|
|
|
|
251752
|
return $self->has_inlined; |
981
|
|
|
|
|
|
|
} |
982
|
|
|
|
|
|
|
|
983
|
|
|
|
|
|
|
sub inline_check { |
984
|
63193
|
|
|
63193
|
1
|
113616
|
my $self = shift; |
985
|
63193
|
50
|
|
|
|
99174
|
_croak 'Cannot inline type constraint check for "%s"', $self |
986
|
|
|
|
|
|
|
unless $self->can_be_inlined; |
987
|
|
|
|
|
|
|
|
988
|
63193
|
100
|
100
|
|
|
109066
|
return $self->parent->inline_check( @_ ) |
989
|
|
|
|
|
|
|
if $self->has_parent && $self->_is_null_constraint; |
990
|
51736
|
100
|
100
|
|
|
93106
|
return '(!!1)' |
991
|
|
|
|
|
|
|
if !$self->has_parent && $self->_is_null_constraint; |
992
|
|
|
|
|
|
|
|
993
|
47699
|
|
|
|
|
81119
|
local $_ = $_[0]; |
994
|
47699
|
|
|
|
|
91568
|
my @r = $self->inlined->( $self, @_ ); |
995
|
47699
|
100
|
66
|
|
|
170695
|
if ( @r and not defined $r[0] ) { |
996
|
6988
|
50
|
|
|
|
13430
|
_croak 'Inlining type constraint check for "%s" returned undef!', $self |
997
|
|
|
|
|
|
|
unless $self->has_parent; |
998
|
6988
|
|
|
|
|
15135
|
$r[0] = $self->parent->inline_check( @_ ); |
999
|
|
|
|
|
|
|
} |
1000
|
|
|
|
|
|
|
my $r = join " && " => map { |
1001
|
47699
|
100
|
100
|
|
|
87690
|
/[;{}]/ && !/\Ado \{.+\}\z/ |
|
57837
|
|
|
|
|
337989
|
|
1002
|
|
|
|
|
|
|
? "do { $SafePackage $_ }" |
1003
|
|
|
|
|
|
|
: "($_)" |
1004
|
|
|
|
|
|
|
} @r; |
1005
|
47699
|
100
|
|
|
|
962016
|
return @r == 1 ? $r : "($r)"; |
1006
|
|
|
|
|
|
|
} #/ sub inline_check |
1007
|
|
|
|
|
|
|
|
1008
|
|
|
|
|
|
|
sub inline_assert { |
1009
|
11058
|
|
|
11058
|
1
|
42537
|
require B; |
1010
|
11058
|
|
|
|
|
17096
|
my $self = shift; |
1011
|
11058
|
|
|
|
|
32853
|
my ( $varname, $typevarname, %extras ) = @_; |
1012
|
|
|
|
|
|
|
|
1013
|
11058
|
|
33
|
|
|
38382
|
$extras{exception_class} ||= $self->exception_class; |
1014
|
|
|
|
|
|
|
|
1015
|
11058
|
|
|
|
|
15837
|
my $inline_check; |
1016
|
11058
|
100
|
|
|
|
19667
|
if ( $self->can_be_inlined ) { |
|
|
100
|
|
|
|
|
|
1017
|
10960
|
|
|
|
|
24556
|
$inline_check = sprintf( '(%s)', $self->inline_check( $varname ) ); |
1018
|
|
|
|
|
|
|
} |
1019
|
|
|
|
|
|
|
elsif ( $typevarname ) { |
1020
|
97
|
|
|
|
|
408
|
$inline_check = sprintf( '%s->check(%s)', $typevarname, $varname ); |
1021
|
|
|
|
|
|
|
} |
1022
|
|
|
|
|
|
|
else { |
1023
|
1
|
|
|
|
|
4
|
_croak 'Cannot inline type constraint check for "%s"', $self; |
1024
|
|
|
|
|
|
|
} |
1025
|
|
|
|
|
|
|
|
1026
|
11057
|
|
|
|
|
30194
|
my $do_wrapper = !delete $extras{no_wrapper}; |
1027
|
|
|
|
|
|
|
|
1028
|
11057
|
|
|
|
|
15592
|
my $inline_throw; |
1029
|
11057
|
100
|
|
|
|
19064
|
if ( $typevarname ) { |
1030
|
|
|
|
|
|
|
$inline_throw = sprintf( |
1031
|
|
|
|
|
|
|
'Type::Tiny::_failed_check(%s, %s, %s, %s)', |
1032
|
|
|
|
|
|
|
$typevarname, |
1033
|
|
|
|
|
|
|
B::perlstring( "$self" ), |
1034
|
|
|
|
|
|
|
$varname, |
1035
|
|
|
|
|
|
|
join( |
1036
|
98
|
|
|
|
|
360
|
',', map +( B::perlstring( $_ ) => B::perlstring( $extras{$_} ) ), |
1037
|
|
|
|
|
|
|
sort keys %extras |
1038
|
|
|
|
|
|
|
), |
1039
|
|
|
|
|
|
|
); |
1040
|
|
|
|
|
|
|
} #/ if ( $typevarname ) |
1041
|
|
|
|
|
|
|
else { |
1042
|
|
|
|
|
|
|
$inline_throw = sprintf( |
1043
|
|
|
|
|
|
|
'Type::Tiny::_failed_check(%s, %s, %s, %s)', |
1044
|
|
|
|
|
|
|
$self->{uniq}, |
1045
|
|
|
|
|
|
|
B::perlstring( "$self" ), |
1046
|
|
|
|
|
|
|
$varname, |
1047
|
|
|
|
|
|
|
join( |
1048
|
10959
|
|
|
|
|
37818
|
',', map +( B::perlstring( $_ ) => B::perlstring( $extras{$_} ) ), |
1049
|
|
|
|
|
|
|
sort keys %extras |
1050
|
|
|
|
|
|
|
), |
1051
|
|
|
|
|
|
|
); |
1052
|
|
|
|
|
|
|
} #/ else [ if ( $typevarname ) ] |
1053
|
|
|
|
|
|
|
|
1054
|
11057
|
100
|
|
|
|
83440
|
$do_wrapper |
1055
|
|
|
|
|
|
|
? qq[do { no warnings "void"; $SafePackage $inline_check or $inline_throw; $varname };] |
1056
|
|
|
|
|
|
|
: qq[ no warnings "void"; $SafePackage $inline_check or $inline_throw; $varname ]; |
1057
|
|
|
|
|
|
|
} #/ sub inline_assert |
1058
|
|
|
|
|
|
|
|
1059
|
|
|
|
|
|
|
sub _failed_check { |
1060
|
417
|
|
|
417
|
|
19741
|
my ( $self, $name, $value, %attrs ) = @_; |
1061
|
417
|
100
|
100
|
|
|
2663
|
$self = $ALL_TYPES{$self} if defined $self && !ref $self; |
1062
|
|
|
|
|
|
|
|
1063
|
|
|
|
|
|
|
my $exception_class = delete( $attrs{exception_class} ) |
1064
|
417
|
|
66
|
|
|
2192
|
|| ( ref $self ? $self->exception_class : 'Error::TypeTiny::Assertion' ); |
1065
|
417
|
|
|
|
|
811
|
my $callback = delete( $attrs{on_die} ); |
1066
|
|
|
|
|
|
|
|
1067
|
417
|
100
|
|
|
|
1336
|
if ( $self ) { |
1068
|
416
|
|
|
|
|
1330
|
return $exception_class->throw_cb( |
1069
|
|
|
|
|
|
|
$callback, |
1070
|
|
|
|
|
|
|
message => $self->get_message( $value ), |
1071
|
|
|
|
|
|
|
type => $self, |
1072
|
|
|
|
|
|
|
value => $value, |
1073
|
|
|
|
|
|
|
%attrs, |
1074
|
|
|
|
|
|
|
); |
1075
|
|
|
|
|
|
|
} |
1076
|
|
|
|
|
|
|
else { |
1077
|
1
|
|
|
|
|
5
|
return $exception_class->throw_cb( |
1078
|
|
|
|
|
|
|
$callback, |
1079
|
|
|
|
|
|
|
message => sprintf( '%s did not pass type constraint "%s"', _dd( $value ), $name ), |
1080
|
|
|
|
|
|
|
value => $value, |
1081
|
|
|
|
|
|
|
%attrs, |
1082
|
|
|
|
|
|
|
); |
1083
|
|
|
|
|
|
|
} |
1084
|
|
|
|
|
|
|
} #/ sub _failed_check |
1085
|
|
|
|
|
|
|
|
1086
|
|
|
|
|
|
|
sub coerce { |
1087
|
567
|
|
|
567
|
1
|
66190
|
my $self = shift; |
1088
|
567
|
|
|
|
|
1316
|
$self->_assert_coercion->coerce( @_ ); |
1089
|
|
|
|
|
|
|
} |
1090
|
|
|
|
|
|
|
|
1091
|
|
|
|
|
|
|
sub assert_coerce { |
1092
|
64
|
|
|
64
|
1
|
431
|
my $self = shift; |
1093
|
64
|
|
|
|
|
161
|
$self->_assert_coercion->assert_coerce( @_ ); |
1094
|
|
|
|
|
|
|
} |
1095
|
|
|
|
|
|
|
|
1096
|
|
|
|
|
|
|
sub is_parameterizable { |
1097
|
13661
|
|
|
13661
|
1
|
30127
|
shift->has_constraint_generator; |
1098
|
|
|
|
|
|
|
} |
1099
|
|
|
|
|
|
|
|
1100
|
|
|
|
|
|
|
sub is_parameterized { |
1101
|
490
|
|
|
490
|
1
|
1642
|
shift->has_parameters; |
1102
|
|
|
|
|
|
|
} |
1103
|
|
|
|
|
|
|
|
1104
|
|
|
|
|
|
|
{ |
1105
|
|
|
|
|
|
|
my %seen; |
1106
|
|
|
|
|
|
|
|
1107
|
|
|
|
|
|
|
sub ____make_key { |
1108
|
|
|
|
|
|
|
#<<< |
1109
|
|
|
|
|
|
|
join ',', map { |
1110
|
1396
|
|
|
1396
|
|
2926
|
Types::TypeTiny::is_TypeTiny( $_ ) ? sprintf( '$Type::Tiny::ALL_TYPES{%s}', defined( $_->{uniq} ) ? $_->{uniq} : '____CANNOT_KEY____' ) : |
1111
|
7
|
50
|
|
|
|
105
|
ref() eq 'ARRAY' ? do { $seen{$_}++ ? '____CANNOT_KEY____' : sprintf( '[%s]', ____make_key( @$_ ) ) } : |
1112
|
18
|
50
|
|
|
|
190
|
ref() eq 'HASH' ? do { $seen{$_}++ ? '____CANNOT_KEY____' : sprintf( '{%s}', ____make_key( do { my %h = %$_; map +( $_, $h{$_} ), sort keys %h; } ) ) } : |
|
18
|
|
|
|
|
52
|
|
|
18
|
|
|
|
|
189
|
|
1113
|
3
|
50
|
|
|
|
49
|
ref() eq 'SCALAR' || ref() eq 'REF' ? do { $seen{$_}++ ? '____CANNOT_KEY____' : sprintf( '\\(%s)', ____make_key( $$_ ) ) } : |
1114
|
|
|
|
|
|
|
!defined() ? 'undef' : |
1115
|
3449
|
50
|
66
|
|
|
69646
|
!ref() ? do { require B; B::perlstring( $_ ) } : |
|
975
|
100
|
|
|
|
13951
|
|
|
975
|
100
|
|
|
|
4921
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
1116
|
|
|
|
|
|
|
'____CANNOT_KEY____'; |
1117
|
|
|
|
|
|
|
} @_; |
1118
|
|
|
|
|
|
|
#>>> |
1119
|
|
|
|
|
|
|
} #/ sub ____make_key |
1120
|
|
|
|
|
|
|
my %param_cache; |
1121
|
|
|
|
|
|
|
|
1122
|
|
|
|
|
|
|
sub parameterize { |
1123
|
1366
|
|
|
1366
|
1
|
133700
|
my $self = shift; |
1124
|
|
|
|
|
|
|
|
1125
|
1366
|
0
|
|
|
|
3637
|
$self->is_parameterizable |
|
|
50
|
|
|
|
|
|
1126
|
|
|
|
|
|
|
or @_ |
1127
|
|
|
|
|
|
|
? _croak( "Type '%s' does not accept parameters", "$self" ) |
1128
|
|
|
|
|
|
|
: return ( $self ); |
1129
|
|
|
|
|
|
|
|
1130
|
1366
|
|
|
|
|
5847
|
@_ = map Types::TypeTiny::to_TypeTiny( $_ ), @_; |
1131
|
|
|
|
|
|
|
|
1132
|
|
|
|
|
|
|
# Generate a key for caching parameterized type constraints, |
1133
|
|
|
|
|
|
|
# but only if all the parameters are strings or type constraints. |
1134
|
1366
|
|
|
|
|
3356
|
%seen = (); |
1135
|
1366
|
|
|
|
|
3821
|
my $key = $self->____make_key( @_ ); |
1136
|
1366
|
100
|
|
|
|
5623
|
undef( $key ) if $key =~ /____CANNOT_KEY____/; |
1137
|
1366
|
100
|
100
|
|
|
7464
|
return $param_cache{$key} if defined $key && defined $param_cache{$key}; |
1138
|
|
|
|
|
|
|
|
1139
|
1004
|
|
|
|
|
1956
|
local $Type::Tiny::parameterize_type = $self; |
1140
|
1004
|
|
|
|
|
1783
|
local $_ = $_[0]; |
1141
|
1004
|
|
|
|
|
1523
|
my $P; |
1142
|
|
|
|
|
|
|
|
1143
|
1004
|
|
|
|
|
3196
|
my ( $constraint, $compiled ) = $self->constraint_generator->( @_ ); |
1144
|
|
|
|
|
|
|
|
1145
|
963
|
100
|
|
|
|
21790
|
if ( Types::TypeTiny::is_TypeTiny( $constraint ) ) { |
1146
|
168
|
|
|
|
|
442
|
$P = $constraint; |
1147
|
|
|
|
|
|
|
} |
1148
|
|
|
|
|
|
|
else { |
1149
|
795
|
|
|
|
|
6037
|
my %options = ( |
1150
|
|
|
|
|
|
|
constraint => $constraint, |
1151
|
|
|
|
|
|
|
display_name => $self->name_generator->( $self, @_ ), |
1152
|
|
|
|
|
|
|
parameters => [@_], |
1153
|
|
|
|
|
|
|
); |
1154
|
795
|
100
|
|
|
|
2819
|
$options{compiled_type_constraint} = $compiled |
1155
|
|
|
|
|
|
|
if $compiled; |
1156
|
795
|
100
|
|
|
|
2253
|
$options{inlined} = $self->inline_generator->( @_ ) |
1157
|
|
|
|
|
|
|
if $self->has_inline_generator; |
1158
|
|
|
|
|
|
|
$options{type_default} = $self->{type_default_generator}->( @_ ) |
1159
|
795
|
100
|
|
|
|
3900
|
if exists $self->{type_default_generator}; # undocumented |
1160
|
|
|
|
|
|
|
exists $options{$_} && !defined $options{$_} && delete $options{$_} |
1161
|
795
|
|
66
|
|
|
9831
|
for keys %options; |
|
|
|
66
|
|
|
|
|
1162
|
|
|
|
|
|
|
|
1163
|
795
|
|
|
|
|
3343
|
$P = $self->create_child_type( %options ); |
1164
|
|
|
|
|
|
|
|
1165
|
795
|
100
|
|
|
|
2757
|
if ( $self->has_coercion_generator ) { |
1166
|
388
|
|
|
|
|
1211
|
my @args = @_; |
1167
|
|
|
|
|
|
|
$P->{_build_coercion} = sub { |
1168
|
191
|
|
|
191
|
|
448
|
my $coercion = shift; |
1169
|
191
|
|
|
|
|
732
|
my $built = $self->coercion_generator->( $self, $P, @args ); |
1170
|
191
|
100
|
|
|
|
606
|
$coercion->add_type_coercions( @{ $built->type_coercion_map } ) if $built; |
|
111
|
|
|
|
|
290
|
|
1171
|
191
|
|
|
|
|
663
|
$coercion->freeze; |
1172
|
388
|
|
|
|
|
2741
|
}; |
1173
|
|
|
|
|
|
|
} |
1174
|
|
|
|
|
|
|
} #/ else [ if ( Types::TypeTiny::is_TypeTiny...)] |
1175
|
|
|
|
|
|
|
|
1176
|
963
|
100
|
|
|
|
3060
|
if ( defined $key ) { |
1177
|
930
|
|
|
|
|
2672
|
$param_cache{$key} = $P; |
1178
|
930
|
|
|
|
|
2445
|
Scalar::Util::weaken( $param_cache{$key} ); |
1179
|
|
|
|
|
|
|
} |
1180
|
|
|
|
|
|
|
|
1181
|
963
|
100
|
|
|
|
2190
|
$P->coercion->freeze unless $self->has_coercion_generator; |
1182
|
|
|
|
|
|
|
|
1183
|
963
|
|
|
|
|
4324
|
return $P; |
1184
|
|
|
|
|
|
|
} #/ sub parameterize |
1185
|
|
|
|
|
|
|
} |
1186
|
|
|
|
|
|
|
|
1187
|
|
|
|
|
|
|
sub child_type_class { |
1188
|
1307
|
|
|
1307
|
1
|
5718
|
__PACKAGE__; |
1189
|
|
|
|
|
|
|
} |
1190
|
|
|
|
|
|
|
|
1191
|
|
|
|
|
|
|
sub create_child_type { |
1192
|
1307
|
|
|
1307
|
1
|
6984
|
my $self = shift; |
1193
|
1307
|
|
|
|
|
2025
|
my %moreopts; |
1194
|
1307
|
100
|
|
|
|
4076
|
$moreopts{is_object} = 1 if $self->{is_object}; |
1195
|
1307
|
|
|
|
|
3496
|
return $self->child_type_class->new( parent => $self, %moreopts, @_ ); |
1196
|
|
|
|
|
|
|
} |
1197
|
|
|
|
|
|
|
|
1198
|
|
|
|
|
|
|
sub complementary_type { |
1199
|
76
|
|
|
76
|
1
|
164
|
my $self = shift; |
1200
|
76
|
|
66
|
|
|
359
|
my $r = ( $self->{complementary_type} ||= $self->_build_complementary_type ); |
1201
|
|
|
|
|
|
|
Scalar::Util::weaken( $self->{complementary_type} ) |
1202
|
76
|
100
|
|
|
|
467
|
unless Scalar::Util::isweak( $self->{complementary_type} ); |
1203
|
76
|
|
|
|
|
1246
|
return $r; |
1204
|
|
|
|
|
|
|
} |
1205
|
|
|
|
|
|
|
|
1206
|
|
|
|
|
|
|
sub _build_complementary_type { |
1207
|
64
|
|
|
64
|
|
104
|
my $self = shift; |
1208
|
|
|
|
|
|
|
my %opts = ( |
1209
|
108
|
|
|
108
|
|
228
|
constraint => sub { not $self->check( $_ ) }, |
1210
|
64
|
|
|
|
|
403
|
display_name => sprintf( "~%s", $self ), |
1211
|
|
|
|
|
|
|
); |
1212
|
64
|
|
|
|
|
196
|
$opts{display_name} =~ s/^\~{2}//; |
1213
|
296
|
|
|
296
|
|
395
|
$opts{inlined} = sub { shift; "not(" . $self->inline_check( @_ ) . ")" } |
|
296
|
|
|
|
|
610
|
|
1214
|
64
|
100
|
|
|
|
154
|
if $self->can_be_inlined; |
1215
|
|
|
|
|
|
|
$opts{display_name} = $opts{name} = $self->{complement_name} |
1216
|
64
|
100
|
|
|
|
192
|
if $self->{complement_name}; |
1217
|
64
|
|
|
|
|
301
|
return "Type::Tiny"->new( %opts ); |
1218
|
|
|
|
|
|
|
} #/ sub _build_complementary_type |
1219
|
|
|
|
|
|
|
|
1220
|
|
|
|
|
|
|
sub _instantiate_moose_type { |
1221
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
1222
|
0
|
|
|
|
|
0
|
my %opts = @_; |
1223
|
0
|
|
|
|
|
0
|
require Moose::Meta::TypeConstraint; |
1224
|
0
|
|
|
|
|
0
|
return "Moose::Meta::TypeConstraint"->new( %opts ); |
1225
|
|
|
|
|
|
|
} |
1226
|
|
|
|
|
|
|
|
1227
|
|
|
|
|
|
|
sub _build_moose_type { |
1228
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
1229
|
|
|
|
|
|
|
|
1230
|
0
|
|
|
|
|
0
|
my $r; |
1231
|
0
|
0
|
|
|
|
0
|
if ( $self->{_is_core} ) { |
1232
|
0
|
|
|
|
|
0
|
require Moose::Util::TypeConstraints; |
1233
|
0
|
|
|
|
|
0
|
$r = Moose::Util::TypeConstraints::find_type_constraint( $self->name ); |
1234
|
0
|
|
|
|
|
0
|
$r->{"Types::TypeTiny::to_TypeTiny"} = $self; |
1235
|
0
|
|
|
|
|
0
|
Scalar::Util::weaken( $r->{"Types::TypeTiny::to_TypeTiny"} ); |
1236
|
|
|
|
|
|
|
} |
1237
|
|
|
|
|
|
|
else { |
1238
|
|
|
|
|
|
|
# Type::Tiny is more flexible than Moose, allowing |
1239
|
|
|
|
|
|
|
# inlined to return a list. So we need to wrap the |
1240
|
|
|
|
|
|
|
# inlined coderef to make sure Moose gets a single |
1241
|
|
|
|
|
|
|
# string. |
1242
|
|
|
|
|
|
|
# |
1243
|
|
|
|
|
|
|
my $wrapped_inlined = sub { |
1244
|
0
|
|
|
0
|
|
0
|
shift; |
1245
|
0
|
|
|
|
|
0
|
$self->inline_check( @_ ); |
1246
|
0
|
|
|
|
|
0
|
}; |
1247
|
|
|
|
|
|
|
|
1248
|
0
|
|
|
|
|
0
|
my %opts; |
1249
|
0
|
0
|
0
|
|
|
0
|
$opts{name} = $self->qualified_name if $self->has_library && !$self->is_anon; |
1250
|
0
|
0
|
|
|
|
0
|
$opts{parent} = $self->parent->moose_type if $self->has_parent; |
1251
|
0
|
0
|
|
|
|
0
|
$opts{constraint} = $self->constraint unless $self->_is_null_constraint; |
1252
|
0
|
0
|
|
|
|
0
|
$opts{message} = $self->message if $self->has_message; |
1253
|
0
|
0
|
|
|
|
0
|
$opts{inlined} = $wrapped_inlined if $self->has_inlined; |
1254
|
|
|
|
|
|
|
|
1255
|
0
|
|
|
|
|
0
|
$r = $self->_instantiate_moose_type( %opts ); |
1256
|
0
|
|
|
|
|
0
|
$r->{"Types::TypeTiny::to_TypeTiny"} = $self; |
1257
|
0
|
|
|
|
|
0
|
$self->{moose_type} = $r; # prevent recursion |
1258
|
0
|
0
|
|
|
|
0
|
$r->coercion( $self->coercion->moose_coercion ) if $self->has_coercion; |
1259
|
|
|
|
|
|
|
} #/ else [ if ( $self->{_is_core})] |
1260
|
|
|
|
|
|
|
|
1261
|
0
|
|
|
|
|
0
|
return $r; |
1262
|
|
|
|
|
|
|
} #/ sub _build_moose_type |
1263
|
|
|
|
|
|
|
|
1264
|
|
|
|
|
|
|
sub _build_mouse_type { |
1265
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
1266
|
|
|
|
|
|
|
|
1267
|
0
|
|
|
|
|
0
|
my %options; |
1268
|
0
|
0
|
0
|
|
|
0
|
$options{name} = $self->qualified_name if $self->has_library && !$self->is_anon; |
1269
|
0
|
0
|
|
|
|
0
|
$options{parent} = $self->parent->mouse_type if $self->has_parent; |
1270
|
0
|
0
|
|
|
|
0
|
$options{constraint} = $self->constraint unless $self->_is_null_constraint; |
1271
|
0
|
0
|
|
|
|
0
|
$options{message} = $self->message if $self->has_message; |
1272
|
|
|
|
|
|
|
|
1273
|
0
|
|
|
|
|
0
|
require Mouse::Meta::TypeConstraint; |
1274
|
0
|
|
|
|
|
0
|
my $r = "Mouse::Meta::TypeConstraint"->new( %options ); |
1275
|
|
|
|
|
|
|
|
1276
|
0
|
|
|
|
|
0
|
$self->{mouse_type} = $r; # prevent recursion |
1277
|
0
|
0
|
|
|
|
0
|
$r->_add_type_coercions( |
1278
|
|
|
|
|
|
|
$self->coercion->freeze->_codelike_type_coercion_map( 'mouse_type' ) ) |
1279
|
|
|
|
|
|
|
if $self->has_coercion; |
1280
|
|
|
|
|
|
|
|
1281
|
0
|
|
|
|
|
0
|
return $r; |
1282
|
|
|
|
|
|
|
} #/ sub _build_mouse_type |
1283
|
|
|
|
|
|
|
|
1284
|
|
|
|
|
|
|
sub exportables { |
1285
|
12735
|
|
|
12735
|
1
|
29386
|
my ( $self, $base_name, $tag ) = ( shift, @_ ); # $tag is undocumented |
1286
|
12735
|
100
|
|
|
|
21613
|
if ( not $self->is_anon ) { |
1287
|
12734
|
|
66
|
|
|
33261
|
$base_name ||= $self->name; |
1288
|
|
|
|
|
|
|
} |
1289
|
12735
|
|
100
|
|
|
50565
|
$tag ||= 0; |
1290
|
|
|
|
|
|
|
|
1291
|
12735
|
|
|
|
|
18072
|
my @exportables; |
1292
|
12735
|
50
|
|
|
|
23202
|
return \@exportables if ! $base_name; |
1293
|
|
|
|
|
|
|
|
1294
|
12735
|
|
|
|
|
65369
|
require Eval::TypeTiny; |
1295
|
|
|
|
|
|
|
|
1296
|
12735
|
100
|
66
|
|
|
63831
|
push @exportables, { |
1297
|
|
|
|
|
|
|
name => $base_name, |
1298
|
|
|
|
|
|
|
code => Eval::TypeTiny::type_to_coderef( $self ), |
1299
|
|
|
|
|
|
|
tags => [ 'types' ], |
1300
|
|
|
|
|
|
|
} if $tag eq 'types' || !$tag; |
1301
|
|
|
|
|
|
|
|
1302
|
12735
|
100
|
100
|
|
|
96762
|
push @exportables, { |
1303
|
|
|
|
|
|
|
name => sprintf( 'is_%s', $base_name ), |
1304
|
|
|
|
|
|
|
code => $self->compiled_check, |
1305
|
|
|
|
|
|
|
tags => [ 'is' ], |
1306
|
|
|
|
|
|
|
} if $tag eq 'is' || !$tag; |
1307
|
|
|
|
|
|
|
|
1308
|
12735
|
100
|
66
|
|
|
75565
|
push @exportables, { |
1309
|
|
|
|
|
|
|
name => sprintf( 'assert_%s', $base_name ), |
1310
|
|
|
|
|
|
|
code => $self->_overload_coderef, |
1311
|
|
|
|
|
|
|
tags => [ 'assert' ], |
1312
|
|
|
|
|
|
|
} if $tag eq 'assert' || !$tag; |
1313
|
|
|
|
|
|
|
|
1314
|
|
|
|
|
|
|
push @exportables, { |
1315
|
|
|
|
|
|
|
name => sprintf( 'to_%s', $base_name ), |
1316
|
|
|
|
|
|
|
code => $self->has_coercion && $self->coercion->frozen |
1317
|
|
|
|
|
|
|
? $self->coercion->compiled_coercion |
1318
|
9
|
|
|
9
|
|
4947
|
: sub ($) { $self->coerce( $_[0] ) }, |
|
|
|
|
9
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
|
649
|
|
|
|
1319
|
12735
|
100
|
100
|
|
|
96605
|
tags => [ 'to' ], |
|
|
100
|
100
|
|
|
|
|
1320
|
|
|
|
|
|
|
} if $tag eq 'to' || !$tag; |
1321
|
|
|
|
|
|
|
|
1322
|
12735
|
|
|
|
|
51741
|
return \@exportables; |
1323
|
|
|
|
|
|
|
} |
1324
|
|
|
|
|
|
|
|
1325
|
|
|
|
|
|
|
sub exportables_by_tag { |
1326
|
575
|
|
|
584
|
1
|
2101
|
my ( $self, $tag, $base_name ) = ( shift, @_ ); |
1327
|
|
|
|
|
|
|
my @matched = grep { |
1328
|
575
|
|
|
|
|
1361
|
my $e = $_; |
1329
|
575
|
50
|
|
|
|
1065
|
grep $_ eq $tag, @{ $e->{tags} || [] }; |
|
575
|
|
|
|
|
4946
|
|
1330
|
575
|
|
|
|
|
1171
|
} @{ $self->exportables( $base_name, $tag ) }; |
|
575
|
|
|
|
|
1736
|
|
1331
|
575
|
100
|
|
|
|
3145
|
return @matched if wantarray; |
1332
|
1
|
50
|
|
|
|
3
|
_croak( 'Expected to find one exportable tagged "%s", found %d', $tag, scalar @matched ) |
1333
|
|
|
|
|
|
|
unless @matched == 1; |
1334
|
1
|
|
|
|
|
3
|
return $matched[0]; |
1335
|
|
|
|
|
|
|
} |
1336
|
|
|
|
|
|
|
|
1337
|
|
|
|
|
|
|
sub _process_coercion_list { |
1338
|
92
|
|
|
97
|
|
224
|
my $self = shift; |
1339
|
|
|
|
|
|
|
|
1340
|
92
|
|
|
|
|
165
|
my @pairs; |
1341
|
92
|
|
|
|
|
297
|
while ( @_ ) { |
1342
|
96
|
|
|
|
|
180
|
my $next = shift; |
1343
|
96
|
100
|
66
|
|
|
661
|
if ( blessed( $next ) |
|
|
100
|
100
|
|
|
|
|
|
|
50
|
66
|
|
|
|
|
1344
|
|
|
|
|
|
|
and $next->isa( 'Type::Coercion' ) |
1345
|
|
|
|
|
|
|
and $next->is_parameterized ) |
1346
|
|
|
|
|
|
|
{ |
1347
|
7
|
|
|
|
|
12
|
push @pairs => ( @{ $next->_reparameterize( $self )->type_coercion_map } ); |
|
7
|
|
|
|
|
24
|
|
1348
|
|
|
|
|
|
|
} |
1349
|
|
|
|
|
|
|
elsif ( blessed( $next ) and $next->can( 'type_coercion_map' ) ) { |
1350
|
|
|
|
|
|
|
push @pairs => ( |
1351
|
9
|
|
|
|
|
16
|
@{ $next->type_coercion_map }, |
|
9
|
|
|
|
|
25
|
|
1352
|
|
|
|
|
|
|
); |
1353
|
|
|
|
|
|
|
} |
1354
|
|
|
|
|
|
|
elsif ( ref( $next ) eq q(ARRAY) ) { |
1355
|
0
|
|
|
|
|
0
|
unshift @_, @$next; |
1356
|
|
|
|
|
|
|
} |
1357
|
|
|
|
|
|
|
else { |
1358
|
80
|
|
|
|
|
348
|
push @pairs => ( |
1359
|
|
|
|
|
|
|
Types::TypeTiny::to_TypeTiny( $next ), |
1360
|
|
|
|
|
|
|
shift, |
1361
|
|
|
|
|
|
|
); |
1362
|
|
|
|
|
|
|
} |
1363
|
|
|
|
|
|
|
} #/ while ( @_ ) |
1364
|
|
|
|
|
|
|
|
1365
|
92
|
|
|
|
|
318
|
return @pairs; |
1366
|
|
|
|
|
|
|
} #/ sub _process_coercion_list |
1367
|
|
|
|
|
|
|
|
1368
|
|
|
|
|
|
|
sub plus_coercions { |
1369
|
89
|
|
|
89
|
1
|
39126
|
my $self = shift; |
1370
|
89
|
|
|
|
|
355
|
my $new = $self->_clone; |
1371
|
|
|
|
|
|
|
$new->coercion->add_type_coercions( |
1372
|
|
|
|
|
|
|
$self->_process_coercion_list( @_ ), |
1373
|
89
|
|
|
|
|
350
|
@{ $self->coercion->type_coercion_map }, |
|
89
|
|
|
|
|
315
|
|
1374
|
|
|
|
|
|
|
); |
1375
|
89
|
|
|
|
|
317
|
$new->coercion->freeze; |
1376
|
89
|
|
|
|
|
663
|
return $new; |
1377
|
|
|
|
|
|
|
} #/ sub plus_coercions |
1378
|
|
|
|
|
|
|
|
1379
|
|
|
|
|
|
|
sub plus_fallback_coercions { |
1380
|
2
|
|
|
2
|
1
|
606
|
my $self = shift; |
1381
|
|
|
|
|
|
|
|
1382
|
2
|
|
|
|
|
7
|
my $new = $self->_clone; |
1383
|
|
|
|
|
|
|
$new->coercion->add_type_coercions( |
1384
|
2
|
|
|
|
|
6
|
@{ $self->coercion->type_coercion_map }, |
|
2
|
|
|
|
|
6
|
|
1385
|
|
|
|
|
|
|
$self->_process_coercion_list( @_ ), |
1386
|
|
|
|
|
|
|
); |
1387
|
2
|
|
|
|
|
10
|
$new->coercion->freeze; |
1388
|
2
|
|
|
|
|
6
|
return $new; |
1389
|
|
|
|
|
|
|
} #/ sub plus_fallback_coercions |
1390
|
|
|
|
|
|
|
|
1391
|
|
|
|
|
|
|
sub minus_coercions { |
1392
|
1
|
|
|
1
|
1
|
605
|
my $self = shift; |
1393
|
|
|
|
|
|
|
|
1394
|
1
|
|
|
|
|
5
|
my $new = $self->_clone; |
1395
|
1
|
|
|
|
|
5
|
my @not = grep Types::TypeTiny::is_TypeTiny( $_ ), |
1396
|
|
|
|
|
|
|
$self->_process_coercion_list( $new, @_ ); |
1397
|
|
|
|
|
|
|
|
1398
|
1
|
|
|
|
|
7
|
my @keep; |
1399
|
1
|
|
|
|
|
4
|
my $c = $self->coercion->type_coercion_map; |
1400
|
1
|
|
|
|
|
7
|
for ( my $i = 0 ; $i <= $#$c ; $i += 2 ) { |
1401
|
4
|
|
|
|
|
6
|
my $keep_this = 1; |
1402
|
4
|
|
|
|
|
7
|
NOT: for my $n ( @not ) { |
1403
|
11
|
100
|
|
|
|
27
|
if ( $c->[$i] == $n ) { |
1404
|
2
|
|
|
|
|
3
|
$keep_this = 0; |
1405
|
2
|
|
|
|
|
8
|
last NOT; |
1406
|
|
|
|
|
|
|
} |
1407
|
|
|
|
|
|
|
} |
1408
|
|
|
|
|
|
|
|
1409
|
4
|
100
|
|
|
|
18
|
push @keep, $c->[$i], $c->[ $i + 1 ] if $keep_this; |
1410
|
|
|
|
|
|
|
} #/ for ( my $i = 0 ; $i <=...) |
1411
|
|
|
|
|
|
|
|
1412
|
1
|
|
|
|
|
4
|
$new->coercion->add_type_coercions( @keep ); |
1413
|
1
|
|
|
|
|
4
|
$new->coercion->freeze; |
1414
|
1
|
|
|
|
|
3
|
return $new; |
1415
|
|
|
|
|
|
|
} #/ sub minus_coercions |
1416
|
|
|
|
|
|
|
|
1417
|
|
|
|
|
|
|
sub no_coercions { |
1418
|
4
|
|
|
4
|
1
|
1126
|
my $new = shift->_clone; |
1419
|
4
|
|
|
|
|
14
|
$new->coercion->freeze; |
1420
|
4
|
|
|
|
|
15
|
$new; |
1421
|
|
|
|
|
|
|
} |
1422
|
|
|
|
|
|
|
|
1423
|
|
|
|
|
|
|
sub coercibles { |
1424
|
7
|
|
|
7
|
1
|
380
|
my $self = shift; |
1425
|
7
|
100
|
|
|
|
21
|
$self->has_coercion ? $self->coercion->_source_type_union : $self; |
1426
|
|
|
|
|
|
|
} |
1427
|
|
|
|
|
|
|
|
1428
|
|
|
|
|
|
|
sub isa { |
1429
|
273697
|
|
|
273697
|
1
|
761985
|
my $self = shift; |
1430
|
|
|
|
|
|
|
|
1431
|
273697
|
0
|
33
|
|
|
544961
|
if ( $INC{"Moose.pm"} |
|
|
|
33
|
|
|
|
|
1432
|
|
|
|
|
|
|
and ref( $self ) |
1433
|
|
|
|
|
|
|
and $_[0] =~ /^(?:Class::MOP|MooseX?::Meta)::(.+)$/ ) |
1434
|
|
|
|
|
|
|
{ |
1435
|
0
|
|
|
|
|
0
|
my $meta = $1; |
1436
|
|
|
|
|
|
|
|
1437
|
0
|
0
|
|
|
|
0
|
return !!1 if $meta eq 'TypeConstraint'; |
1438
|
0
|
0
|
|
|
|
0
|
return $self->is_parameterized if $meta eq 'TypeConstraint::Parameterized'; |
1439
|
0
|
0
|
|
|
|
0
|
return $self->is_parameterizable if $meta eq 'TypeConstraint::Parameterizable'; |
1440
|
0
|
0
|
|
|
|
0
|
return $self->isa( 'Type::Tiny::Union' ) if $meta eq 'TypeConstraint::Union'; |
1441
|
|
|
|
|
|
|
|
1442
|
0
|
|
|
|
|
0
|
my $inflate = $self->moose_type; |
1443
|
0
|
|
|
|
|
0
|
return $inflate->isa( @_ ); |
1444
|
|
|
|
|
|
|
} #/ if ( $INC{"Moose.pm"} ...) |
1445
|
|
|
|
|
|
|
|
1446
|
273697
|
0
|
33
|
|
|
518744
|
if ( $INC{"Mouse.pm"} |
|
|
|
33
|
|
|
|
|
1447
|
|
|
|
|
|
|
and ref( $self ) |
1448
|
|
|
|
|
|
|
and $_[0] eq 'Mouse::Meta::TypeConstraint' ) |
1449
|
|
|
|
|
|
|
{ |
1450
|
0
|
|
|
|
|
0
|
return !!1; |
1451
|
|
|
|
|
|
|
} |
1452
|
|
|
|
|
|
|
|
1453
|
273697
|
|
|
|
|
1201237
|
$self->SUPER::isa( @_ ); |
1454
|
|
|
|
|
|
|
} #/ sub isa |
1455
|
|
|
|
|
|
|
|
1456
|
|
|
|
|
|
|
sub _build_my_methods { |
1457
|
141
|
|
|
141
|
|
731
|
return {}; |
1458
|
|
|
|
|
|
|
} |
1459
|
|
|
|
|
|
|
|
1460
|
|
|
|
|
|
|
sub _lookup_my_method { |
1461
|
1278
|
|
|
1278
|
|
1794
|
my $self = shift; |
1462
|
1278
|
|
|
|
|
2822
|
my ( $name ) = @_; |
1463
|
|
|
|
|
|
|
|
1464
|
1278
|
100
|
|
|
|
2354
|
if ( $self->my_methods->{$name} ) { |
1465
|
614
|
|
|
|
|
1160
|
return $self->my_methods->{$name}; |
1466
|
|
|
|
|
|
|
} |
1467
|
|
|
|
|
|
|
|
1468
|
664
|
100
|
|
|
|
1380
|
if ( $self->has_parent ) { |
1469
|
662
|
|
|
|
|
1370
|
return $self->parent->_lookup_my_method( @_ ); |
1470
|
|
|
|
|
|
|
} |
1471
|
|
|
|
|
|
|
|
1472
|
2
|
|
|
|
|
8
|
return; |
1473
|
|
|
|
|
|
|
} #/ sub _lookup_my_method |
1474
|
|
|
|
|
|
|
|
1475
|
|
|
|
|
|
|
my %object_methods = ( |
1476
|
|
|
|
|
|
|
with_attribute_values => 1, stringifies_to => 1, |
1477
|
|
|
|
|
|
|
numifies_to => 1 |
1478
|
|
|
|
|
|
|
); |
1479
|
|
|
|
|
|
|
|
1480
|
|
|
|
|
|
|
sub can { |
1481
|
79920
|
|
|
79920
|
1
|
163625
|
my $self = shift; |
1482
|
|
|
|
|
|
|
|
1483
|
79920
|
50
|
66
|
|
|
191391
|
return !!0 |
|
|
|
33
|
|
|
|
|
1484
|
|
|
|
|
|
|
if $_[0] eq 'type_parameter' |
1485
|
|
|
|
|
|
|
&& blessed( $_[0] ) |
1486
|
|
|
|
|
|
|
&& $_[0]->has_parameters; |
1487
|
|
|
|
|
|
|
|
1488
|
79920
|
|
|
|
|
251765
|
my $can = $self->SUPER::can( @_ ); |
1489
|
79920
|
100
|
|
|
|
632514
|
return $can if $can; |
1490
|
|
|
|
|
|
|
|
1491
|
42157
|
100
|
|
|
|
98758
|
if ( ref( $self ) ) { |
1492
|
42156
|
50
|
|
|
|
85133
|
if ( $INC{"Moose.pm"} ) { |
1493
|
0
|
|
|
|
|
0
|
my $method = $self->moose_type->can( @_ ); |
1494
|
0
|
|
|
0
|
|
0
|
return sub { shift->moose_type->$method( @_ ) } |
1495
|
0
|
0
|
|
|
|
0
|
if $method; |
1496
|
|
|
|
|
|
|
} |
1497
|
42156
|
100
|
|
|
|
98406
|
if ( $_[0] =~ /\Amy_(.+)\z/ ) { |
1498
|
4
|
|
|
|
|
9
|
my $method = $self->_lookup_my_method( $1 ); |
1499
|
4
|
100
|
|
|
|
13
|
return $method if $method; |
1500
|
|
|
|
|
|
|
} |
1501
|
42154
|
100
|
100
|
|
|
125118
|
if ( $self->{is_object} && $object_methods{ $_[0] } ) { |
1502
|
1
|
|
|
|
|
949
|
require Type::Tiny::ConstrainedObject; |
1503
|
1
|
|
|
|
|
14
|
return Type::Tiny::ConstrainedObject->can( $_[0] ); |
1504
|
|
|
|
|
|
|
} |
1505
|
42153
|
|
|
|
|
89310
|
for my $util ( qw/ grep map sort rsort first any all assert_any assert_all / ) { |
1506
|
379233
|
100
|
|
|
|
638143
|
if ( $_[0] eq $util ) { |
1507
|
36
|
|
66
|
|
|
142
|
$self->{'_util'}{$util} ||= eval { $self->_build_util( $util ) }; |
|
36
|
|
|
|
|
84
|
|
1508
|
36
|
100
|
|
|
|
151
|
return unless $self->{'_util'}{$util}; |
1509
|
34
|
|
|
0
|
|
170
|
return sub { my $s = shift; $s->{'_util'}{$util}( @_ ) }; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
1510
|
|
|
|
|
|
|
} |
1511
|
|
|
|
|
|
|
} |
1512
|
|
|
|
|
|
|
} #/ if ( ref( $self ) ) |
1513
|
|
|
|
|
|
|
|
1514
|
42118
|
|
|
|
|
261263
|
return; |
1515
|
|
|
|
|
|
|
} #/ sub can |
1516
|
|
|
|
|
|
|
|
1517
|
|
|
|
|
|
|
sub AUTOLOAD { |
1518
|
686
|
|
|
686
|
|
15581
|
my $self = shift; |
1519
|
686
|
|
|
|
|
4135
|
my ( $m ) = ( our $AUTOLOAD =~ /::(\w+)$/ ); |
1520
|
686
|
50
|
|
|
|
1963
|
return if $m eq 'DESTROY'; |
1521
|
|
|
|
|
|
|
|
1522
|
686
|
50
|
|
|
|
1653
|
if ( ref( $self ) ) { |
1523
|
686
|
50
|
|
|
|
1660
|
if ( $INC{"Moose.pm"} ) { |
1524
|
0
|
|
|
|
|
0
|
my $method = $self->moose_type->can( $m ); |
1525
|
0
|
0
|
|
|
|
0
|
return $self->moose_type->$method( @_ ) if $method; |
1526
|
|
|
|
|
|
|
} |
1527
|
686
|
100
|
|
|
|
2285
|
if ( $m =~ /\Amy_(.+)\z/ ) { |
1528
|
612
|
|
|
|
|
1467
|
my $method = $self->_lookup_my_method( $1 ); |
1529
|
612
|
50
|
|
|
|
2563
|
return &$method( $self, @_ ) if $method; |
1530
|
|
|
|
|
|
|
} |
1531
|
74
|
50
|
66
|
|
|
223
|
if ( $self->{is_object} && $object_methods{$m} ) { |
1532
|
3
|
|
|
|
|
1099
|
require Type::Tiny::ConstrainedObject; |
1533
|
3
|
|
|
|
|
17
|
unshift @_, $self; |
1534
|
279
|
|
|
279
|
|
3297
|
no strict 'refs'; |
|
279
|
|
|
|
|
831
|
|
|
279
|
|
|
|
|
399904
|
|
1535
|
3
|
|
|
|
|
7
|
goto \&{"Type::Tiny::ConstrainedObject::$m"}; |
|
3
|
|
|
|
|
28
|
|
1536
|
|
|
|
|
|
|
} |
1537
|
71
|
|
|
|
|
154
|
for my $util ( qw/ grep map sort rsort first any all assert_any assert_all / ) { |
1538
|
385
|
100
|
|
|
|
695
|
if ( $m eq $util ) { |
1539
|
70
|
|
66
|
|
|
951
|
return ( $self->{'_util'}{$util} ||= $self->_build_util( $util ) )->( @_ ); |
1540
|
|
|
|
|
|
|
} |
1541
|
|
|
|
|
|
|
} |
1542
|
|
|
|
|
|
|
} #/ if ( ref( $self ) ) |
1543
|
|
|
|
|
|
|
|
1544
|
1
|
|
33
|
|
|
5
|
_croak q[Can't locate object method "%s" via package "%s"], $m, |
1545
|
|
|
|
|
|
|
ref( $self ) || $self; |
1546
|
|
|
|
|
|
|
} #/ sub AUTOLOAD |
1547
|
|
|
|
|
|
|
|
1548
|
|
|
|
|
|
|
sub DOES { |
1549
|
45
|
|
|
45
|
1
|
118
|
my $self = shift; |
1550
|
|
|
|
|
|
|
|
1551
|
45
|
50
|
33
|
|
|
202
|
return !!1 |
1552
|
|
|
|
|
|
|
if ref( $self ) |
1553
|
|
|
|
|
|
|
&& $_[0] =~ m{^ Type::API::Constraint (?: ::Coercible | ::Inlinable )? $}x; |
1554
|
45
|
50
|
33
|
|
|
117
|
return !!1 if !ref( $self ) && $_[0] eq 'Type::API::Constraint::Constructor'; |
1555
|
|
|
|
|
|
|
|
1556
|
45
|
50
|
|
|
|
365
|
"UNIVERSAL"->can( "DOES" ) ? $self->SUPER::DOES( @_ ) : $self->isa( @_ ); |
1557
|
|
|
|
|
|
|
} #/ sub DOES |
1558
|
|
|
|
|
|
|
|
1559
|
|
|
|
|
|
|
sub _has_xsub { |
1560
|
1
|
|
|
1
|
|
577
|
require B; |
1561
|
1
|
|
|
|
|
4
|
!!B::svref_2object( shift->compiled_check )->XSUB; |
1562
|
|
|
|
|
|
|
} |
1563
|
|
|
|
|
|
|
|
1564
|
|
|
|
|
|
|
sub _build_util { |
1565
|
82
|
|
|
82
|
|
187
|
my ( $self, $func ) = @_; |
1566
|
82
|
|
|
|
|
257
|
Scalar::Util::weaken( my $type = $self ); |
1567
|
|
|
|
|
|
|
|
1568
|
82
|
100
|
100
|
|
|
726
|
if ( $func eq 'grep' |
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
1569
|
|
|
|
|
|
|
|| $func eq 'first' |
1570
|
|
|
|
|
|
|
|| $func eq 'any' |
1571
|
|
|
|
|
|
|
|| $func eq 'all' |
1572
|
|
|
|
|
|
|
|| $func eq 'assert_any' |
1573
|
|
|
|
|
|
|
|| $func eq 'assert_all' ) |
1574
|
|
|
|
|
|
|
{ |
1575
|
43
|
|
|
|
|
75
|
my ( $inline, $compiled ); |
1576
|
|
|
|
|
|
|
|
1577
|
43
|
100
|
|
|
|
100
|
if ( $self->can_be_inlined ) { |
1578
|
13
|
|
|
|
|
37
|
$inline = $self->inline_check( '$_' ); |
1579
|
|
|
|
|
|
|
} |
1580
|
|
|
|
|
|
|
else { |
1581
|
30
|
|
|
|
|
65
|
$compiled = $self->compiled_check; |
1582
|
30
|
|
|
|
|
55
|
$inline = '$compiled->($_)'; |
1583
|
|
|
|
|
|
|
} |
1584
|
|
|
|
|
|
|
|
1585
|
43
|
100
|
|
|
|
187
|
if ( $func eq 'grep' ) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
1586
|
5
|
|
|
|
|
618
|
return eval "sub { grep { $inline } \@_ }"; |
1587
|
|
|
|
|
|
|
} |
1588
|
|
|
|
|
|
|
elsif ( $func eq 'first' ) { |
1589
|
5
|
|
|
|
|
567
|
return eval "sub { for (\@_) { return \$_ if ($inline) }; undef; }"; |
1590
|
|
|
|
|
|
|
} |
1591
|
|
|
|
|
|
|
elsif ( $func eq 'any' ) { |
1592
|
8
|
|
|
|
|
888
|
return eval "sub { for (\@_) { return !!1 if ($inline) }; !!0; }"; |
1593
|
|
|
|
|
|
|
} |
1594
|
|
|
|
|
|
|
elsif ( $func eq 'assert_any' ) { |
1595
|
8
|
|
|
|
|
20
|
my $qname = B::perlstring( $self->name ); |
1596
|
|
|
|
|
|
|
return |
1597
|
|
|
|
|
|
|
eval |
1598
|
8
|
|
|
|
|
1119
|
"sub { for (\@_) { return \@_ if ($inline) }; Type::Tiny::_failed_check(\$type, $qname, \@_ ? \$_[-1] : undef); }"; |
1599
|
|
|
|
|
|
|
} |
1600
|
|
|
|
|
|
|
elsif ( $func eq 'all' ) { |
1601
|
9
|
|
|
|
|
1037
|
return eval "sub { for (\@_) { return !!0 unless ($inline) }; !!1; }"; |
1602
|
|
|
|
|
|
|
} |
1603
|
|
|
|
|
|
|
elsif ( $func eq 'assert_all' ) { |
1604
|
8
|
|
|
|
|
21
|
my $qname = B::perlstring( $self->name ); |
1605
|
|
|
|
|
|
|
return |
1606
|
|
|
|
|
|
|
eval |
1607
|
8
|
|
|
|
|
1136
|
"sub { my \$idx = 0; for (\@_) { Type::Tiny::_failed_check(\$type, $qname, \$_, varname => sprintf('\$_[%d]', \$idx)) unless ($inline); ++\$idx }; \@_; }"; |
1608
|
|
|
|
|
|
|
} |
1609
|
|
|
|
|
|
|
} #/ if ( $func eq 'grep' ||...) |
1610
|
|
|
|
|
|
|
|
1611
|
39
|
100
|
|
|
|
94
|
if ( $func eq 'map' ) { |
1612
|
8
|
|
|
|
|
16
|
my ( $inline, $compiled ); |
1613
|
8
|
|
|
|
|
23
|
my $c = $self->_assert_coercion; |
1614
|
|
|
|
|
|
|
|
1615
|
4
|
100
|
|
|
|
14
|
if ( $c->can_be_inlined ) { |
1616
|
1
|
|
|
|
|
5
|
$inline = $c->inline_coercion( '$_' ); |
1617
|
|
|
|
|
|
|
} |
1618
|
|
|
|
|
|
|
else { |
1619
|
3
|
|
|
|
|
10
|
$compiled = $c->compiled_coercion; |
1620
|
3
|
|
|
|
|
7
|
$inline = '$compiled->($_)'; |
1621
|
|
|
|
|
|
|
} |
1622
|
|
|
|
|
|
|
|
1623
|
4
|
|
|
|
|
430
|
return eval "sub { map { $inline } \@_ }"; |
1624
|
|
|
|
|
|
|
} #/ if ( $func eq 'map' ) |
1625
|
|
|
|
|
|
|
|
1626
|
31
|
100
|
100
|
|
|
190
|
if ( $func eq 'sort' || $func eq 'rsort' ) { |
1627
|
29
|
|
|
|
|
48
|
my ( $inline, $compiled ); |
1628
|
|
|
|
|
|
|
|
1629
|
29
|
|
|
76
|
|
148
|
my $ptype = $self->find_parent( sub { $_->has_sorter } ); |
|
76
|
|
|
|
|
181
|
|
1630
|
29
|
100
|
|
|
|
118
|
_croak "No sorter for this type constraint" unless $ptype; |
1631
|
|
|
|
|
|
|
|
1632
|
27
|
|
|
|
|
88
|
my $sorter = $ptype->sorter; |
1633
|
|
|
|
|
|
|
|
1634
|
|
|
|
|
|
|
# Schwarzian transformation |
1635
|
27
|
100
|
|
|
|
87
|
if ( ref( $sorter ) eq 'ARRAY' ) { |
1636
|
6
|
|
|
|
|
12
|
my $sort_key; |
1637
|
6
|
|
|
|
|
19
|
( $sorter, $sort_key ) = @$sorter; |
1638
|
|
|
|
|
|
|
|
1639
|
6
|
100
|
|
|
|
23
|
if ( $func eq 'sort' ) { |
|
|
50
|
|
|
|
|
|
1640
|
|
|
|
|
|
|
return |
1641
|
|
|
|
|
|
|
eval |
1642
|
4
|
|
|
|
|
654
|
"our (\$a, \$b); sub { map \$_->[0], sort { \$sorter->(\$a->[1],\$b->[1]) } map [\$_,\$sort_key->(\$_)], \@_ }"; |
1643
|
|
|
|
|
|
|
} |
1644
|
|
|
|
|
|
|
elsif ( $func eq 'rsort' ) { |
1645
|
|
|
|
|
|
|
return |
1646
|
|
|
|
|
|
|
eval |
1647
|
2
|
|
|
|
|
291
|
"our (\$a, \$b); sub { map \$_->[0], sort { \$sorter->(\$b->[1],\$a->[1]) } map [\$_,\$sort_key->(\$_)], \@_ }"; |
1648
|
|
|
|
|
|
|
} |
1649
|
|
|
|
|
|
|
} #/ if ( ref( $sorter ) eq...) |
1650
|
|
|
|
|
|
|
|
1651
|
|
|
|
|
|
|
# Simple sort |
1652
|
|
|
|
|
|
|
else { |
1653
|
21
|
100
|
|
|
|
57
|
if ( $func eq 'sort' ) { |
|
|
50
|
|
|
|
|
|
1654
|
12
|
|
|
|
|
1352
|
return eval "our (\$a, \$b); sub { sort { \$sorter->(\$a,\$b) } \@_ }"; |
1655
|
|
|
|
|
|
|
} |
1656
|
|
|
|
|
|
|
elsif ( $func eq 'rsort' ) { |
1657
|
9
|
|
|
|
|
953
|
return eval "our (\$a, \$b); sub { sort { \$sorter->(\$b,\$a) } \@_ }"; |
1658
|
|
|
|
|
|
|
} |
1659
|
|
|
|
|
|
|
} |
1660
|
|
|
|
|
|
|
} #/ if ( $func eq 'sort' ||...) |
1661
|
|
|
|
|
|
|
|
1662
|
2
|
|
|
|
|
20
|
die "Unknown function: $func"; |
1663
|
|
|
|
|
|
|
} #/ sub _build_util |
1664
|
|
|
|
|
|
|
|
1665
|
287
|
|
|
287
|
1
|
7909
|
sub of { shift->parameterize( @_ ) } |
1666
|
138
|
|
|
138
|
1
|
61114
|
sub where { shift->create_child_type( constraint => @_ ) } |
1667
|
|
|
|
|
|
|
|
1668
|
|
|
|
|
|
|
# fill out Moose-compatible API |
1669
|
1
|
|
|
1
|
1
|
103
|
sub inline_environment { +{} } |
1670
|
1
|
|
|
1
|
|
10
|
sub _inline_check { shift->inline_check( @_ ) } |
1671
|
2
|
|
|
2
|
|
562
|
sub _compiled_type_constraint { shift->compiled_check( @_ ) } |
1672
|
1
|
|
|
1
|
1
|
15
|
sub meta { _croak( "Not really a Moose::Meta::TypeConstraint. Sorry!" ) } |
1673
|
2
|
|
|
2
|
1
|
16
|
sub compile_type_constraint { shift->compiled_check } |
1674
|
2
|
|
|
2
|
|
31
|
sub _actually_compile_type_constraint { shift->_build_compiled_check } |
1675
|
1
|
|
|
1
|
1
|
388
|
sub hand_optimized_type_constraint { shift->{hand_optimized_type_constraint} } |
1676
|
|
|
|
|
|
|
|
1677
|
|
|
|
|
|
|
sub has_hand_optimized_type_constraint { |
1678
|
1
|
|
|
1
|
1
|
12
|
exists( shift->{hand_optimized_type_constraint} ); |
1679
|
|
|
|
|
|
|
} |
1680
|
207
|
|
50
|
207
|
1
|
1656
|
sub type_parameter { ( shift->parameters || [] )->[0] } |
1681
|
|
|
|
|
|
|
|
1682
|
|
|
|
|
|
|
sub parameterized_from { |
1683
|
5
|
50
|
|
5
|
1
|
20
|
$_[0]->is_parameterized ? shift->parent : _croak( "Not a parameterized type" ); |
1684
|
|
|
|
|
|
|
} |
1685
|
2
|
|
|
2
|
1
|
15
|
sub has_parameterized_from { $_[0]->is_parameterized } |
1686
|
|
|
|
|
|
|
|
1687
|
|
|
|
|
|
|
# some stuff for Mouse-compatible API |
1688
|
2
|
|
|
2
|
|
16
|
sub __is_parameterized { shift->is_parameterized( @_ ) } |
1689
|
1
|
|
|
1
|
|
12
|
sub _add_type_coercions { shift->coercion->add_type_coercions( @_ ) } |
1690
|
1
|
|
|
1
|
|
690
|
sub _as_string { shift->qualified_name( @_ ) } |
1691
|
1
|
|
|
1
|
|
5
|
sub _compiled_type_coercion { shift->coercion->compiled_coercion( @_ ) } |
1692
|
2
|
|
|
2
|
|
576
|
sub _identity { Scalar::Util::refaddr( shift ) } |
1693
|
|
|
|
|
|
|
|
1694
|
|
|
|
|
|
|
sub _unite { |
1695
|
1
|
|
|
1
|
|
455
|
require Type::Tiny::Union; |
1696
|
1
|
|
|
|
|
7
|
"Type::Tiny::Union"->new( type_constraints => \@_ ); |
1697
|
|
|
|
|
|
|
} |
1698
|
|
|
|
|
|
|
|
1699
|
|
|
|
|
|
|
# Hooks for Type::Tie |
1700
|
|
|
|
|
|
|
sub TIESCALAR { |
1701
|
1
|
|
|
1
|
|
1685
|
require Type::Tie; |
1702
|
1
|
|
|
|
|
6
|
unshift @_, 'Type::Tie::SCALAR'; |
1703
|
1
|
|
|
|
|
5
|
goto \&Type::Tie::SCALAR::TIESCALAR; |
1704
|
|
|
|
|
|
|
} |
1705
|
|
|
|
|
|
|
|
1706
|
|
|
|
|
|
|
sub TIEARRAY { |
1707
|
1
|
|
|
1
|
|
2563
|
require Type::Tie; |
1708
|
1
|
|
|
|
|
4
|
unshift @_, 'Type::Tie::ARRAY'; |
1709
|
1
|
|
|
|
|
6
|
goto \&Type::Tie::ARRAY::TIEARRAY; |
1710
|
|
|
|
|
|
|
} |
1711
|
|
|
|
|
|
|
|
1712
|
|
|
|
|
|
|
sub TIEHASH { |
1713
|
1
|
|
|
1
|
|
2273
|
require Type::Tie; |
1714
|
1
|
|
|
|
|
4
|
unshift @_, 'Type::Tie::HASH'; |
1715
|
1
|
|
|
|
|
4
|
goto \&Type::Tie::HASH::TIEHASH; |
1716
|
|
|
|
|
|
|
} |
1717
|
|
|
|
|
|
|
|
1718
|
|
|
|
|
|
|
1; |
1719
|
|
|
|
|
|
|
|
1720
|
|
|
|
|
|
|
__END__ |