line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
18
|
|
|
18
|
|
123843
|
use 5.008005; |
|
18
|
|
|
|
|
72
|
|
2
|
18
|
|
|
18
|
|
75
|
use strict; |
|
18
|
|
|
|
|
33
|
|
|
18
|
|
|
|
|
368
|
|
3
|
18
|
|
|
18
|
|
73
|
use warnings; |
|
18
|
|
|
|
|
37
|
|
|
18
|
|
|
|
|
393
|
|
4
|
18
|
|
|
18
|
|
71
|
use XSLoader (); |
|
18
|
|
|
|
|
29
|
|
|
18
|
|
|
|
|
1198
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
package Type::Tiny::XS; |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
our $AUTHORITY = 'cpan:TOBYINK'; |
9
|
|
|
|
|
|
|
our $VERSION = '0.023'; |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
__PACKAGE__->XSLoader::load( $VERSION ); |
12
|
|
|
|
|
|
|
|
13
|
18
|
|
|
18
|
|
98
|
use Scalar::Util qw(refaddr); |
|
18
|
|
|
|
|
34
|
|
|
18
|
|
|
|
|
3703
|
|
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
my %names = ( |
16
|
|
|
|
|
|
|
map +( $_ => __PACKAGE__ . "::$_" ), qw/ |
17
|
|
|
|
|
|
|
Any ArrayRef Bool ClassName CodeRef Defined |
18
|
|
|
|
|
|
|
FileHandle GlobRef HashRef Int Num Object |
19
|
|
|
|
|
|
|
Ref RegexpRef ScalarRef Str Undef Value |
20
|
|
|
|
|
|
|
PositiveInt PositiveOrZeroInt NonEmptyStr |
21
|
|
|
|
|
|
|
ArrayLike HashLike CodeLike StringLike |
22
|
|
|
|
|
|
|
Map Tuple Enum AnyOf AllOf |
23
|
|
|
|
|
|
|
/ |
24
|
|
|
|
|
|
|
); |
25
|
|
|
|
|
|
|
$names{Item} = $names{Any}; |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
if ( $] lt '5.010000' ) { |
28
|
|
|
|
|
|
|
require MRO::Compat; |
29
|
|
|
|
|
|
|
*Type::Tiny::XS::Util::get_linear_isa = \&mro::get_linear_isa; |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
my $overloaded = sub { |
32
|
|
|
|
|
|
|
require overload; |
33
|
|
|
|
|
|
|
overload::Overloaded( ref $_[0] or $_[0] ) |
34
|
|
|
|
|
|
|
and overload::Method( ( ref $_[0] or $_[0] ), $_[1] ); |
35
|
|
|
|
|
|
|
}; |
36
|
|
|
|
|
|
|
|
37
|
18
|
|
|
18
|
|
113
|
no warnings qw( uninitialized redefine once ); |
|
18
|
|
|
|
|
32
|
|
|
18
|
|
|
|
|
5528
|
|
38
|
|
|
|
|
|
|
*StringLike = sub { |
39
|
|
|
|
|
|
|
defined( $_[0] ) && !ref( $_[0] ) |
40
|
|
|
|
|
|
|
or Scalar::Util::blessed( $_[0] ) && $overloaded->( $_[0], q[""] ); |
41
|
|
|
|
|
|
|
}; |
42
|
|
|
|
|
|
|
*CodeLike = sub { |
43
|
|
|
|
|
|
|
ref( $_[0] ) eq 'CODE' |
44
|
|
|
|
|
|
|
or Scalar::Util::blessed( $_[0] ) && $overloaded->( $_[0], q[&{}] ); |
45
|
|
|
|
|
|
|
}; |
46
|
|
|
|
|
|
|
*HashLike = sub { |
47
|
|
|
|
|
|
|
ref( $_[0] ) eq 'HASH' |
48
|
|
|
|
|
|
|
or Scalar::Util::blessed( $_[0] ) && $overloaded->( $_[0], q[%{}] ); |
49
|
|
|
|
|
|
|
}; |
50
|
|
|
|
|
|
|
*ArrayLike = sub { |
51
|
|
|
|
|
|
|
ref( $_[0] ) eq 'ARRAY' |
52
|
|
|
|
|
|
|
or Scalar::Util::blessed( $_[0] ) && $overloaded->( $_[0], q[@{}] ); |
53
|
|
|
|
|
|
|
}; |
54
|
|
|
|
|
|
|
} #/ if ( $] < '5.010000' [) |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
my %coderefs; |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
sub _know { |
59
|
579
|
|
|
579
|
|
964
|
my ( $coderef, $type ) = @_; |
60
|
579
|
|
|
|
|
1367
|
$coderefs{ refaddr( $coderef ) } = $type; |
61
|
|
|
|
|
|
|
} |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
sub is_known { |
64
|
3
|
|
|
3
|
1
|
1571
|
my $coderef = shift; |
65
|
3
|
|
|
|
|
12
|
$coderefs{ refaddr( $coderef ) }; |
66
|
|
|
|
|
|
|
} |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
for ( reverse sort keys %names ) { |
69
|
18
|
|
|
18
|
|
112
|
no strict qw(refs); |
|
18
|
|
|
|
|
32
|
|
|
18
|
|
|
|
|
1294
|
|
70
|
|
|
|
|
|
|
_know \&{ $names{$_} }, $_; |
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
my $id = 0; |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
sub get_coderef_for { |
76
|
44
|
|
|
44
|
1
|
26480
|
my $type = $_[0]; |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
return do { |
79
|
18
|
|
|
18
|
|
111
|
no strict qw(refs); |
|
18
|
|
|
|
|
41
|
|
|
18
|
|
|
|
|
15209
|
|
80
|
23
|
|
|
|
|
27
|
\&{ $names{$type} }; |
|
23
|
|
|
|
|
104
|
|
81
|
44
|
100
|
|
|
|
121
|
} if exists $names{$type}; |
82
|
|
|
|
|
|
|
|
83
|
21
|
|
|
|
|
30
|
my $made; |
84
|
|
|
|
|
|
|
|
85
|
21
|
100
|
66
|
|
|
235
|
if ( $type =~ /^ArrayRef\[(.+)\]$/ ) { |
|
|
100
|
66
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
86
|
7
|
50
|
|
|
|
49
|
my $child = get_coderef_for( $1 ) or return; |
87
|
7
|
|
|
|
|
34
|
$made = _parameterize_ArrayRef_for( $child ); |
88
|
|
|
|
|
|
|
} |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
elsif ( $] ge '5.010000' and $type =~ /^ArrayLike\[(.+)\]$/ ) { |
91
|
1
|
50
|
|
|
|
3
|
my $child = get_coderef_for( $1 ) or return; |
92
|
1
|
|
|
|
|
5
|
$made = _parameterize_ArrayLike_for( $child ); |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
elsif ( $type =~ /^HashRef\[(.+)\]$/ ) { |
96
|
2
|
50
|
|
|
|
24
|
my $child = get_coderef_for( $1 ) or return; |
97
|
2
|
|
|
|
|
8
|
$made = _parameterize_HashRef_for( $child ); |
98
|
|
|
|
|
|
|
} |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
elsif ( $] ge '5.010000' and $type =~ /^HashLike\[(.+)\]$/ ) { |
101
|
1
|
50
|
|
|
|
2
|
my $child = get_coderef_for( $1 ) or return; |
102
|
1
|
|
|
|
|
5
|
$made = _parameterize_HashLike_for( $child ); |
103
|
|
|
|
|
|
|
} |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
elsif ( $type =~ /^Map\[(.+),(.+)\]$/ ) { |
106
|
2
|
|
|
|
|
4
|
my @children; |
107
|
2
|
50
|
|
|
|
4
|
if ( eval { require Type::Parser } ) { |
|
2
|
|
|
|
|
1421
|
|
108
|
2
|
|
|
|
|
6087
|
@children = map scalar( get_coderef_for( $_ ) ), _parse_parameters( $type ); |
109
|
|
|
|
|
|
|
} |
110
|
|
|
|
|
|
|
else { |
111
|
0
|
|
|
|
|
0
|
push @children, get_coderef_for( $1 ); |
112
|
0
|
|
|
|
|
0
|
push @children, get_coderef_for( $2 ); |
113
|
|
|
|
|
|
|
} |
114
|
2
|
50
|
|
|
|
7
|
@children == 2 or return; |
115
|
2
|
|
50
|
|
|
9
|
defined or return for @children; |
116
|
2
|
|
|
|
|
9
|
$made = _parameterize_Map_for( \@children ); |
117
|
|
|
|
|
|
|
} #/ elsif ( $type =~ /^Map\[(.+),(.+)\]$/) |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
elsif ( $type =~ /^(AnyOf|AllOf|Tuple)\[(.+)\]$/ ) { |
120
|
4
|
|
|
|
|
11
|
my $base = $1; |
121
|
|
|
|
|
|
|
my @children = |
122
|
|
|
|
|
|
|
map scalar( get_coderef_for( $_ ) ), |
123
|
4
|
50
|
|
|
|
5
|
( eval { require Type::Parser } ) |
|
4
|
|
|
|
|
407
|
|
124
|
|
|
|
|
|
|
? _parse_parameters( $type ) |
125
|
|
|
|
|
|
|
: split( /,/, $2 ); |
126
|
4
|
|
50
|
|
|
18
|
defined or return for @children; |
127
|
4
|
|
|
|
|
24
|
my $maker = __PACKAGE__->can( "_parameterize_${base}_for" ); |
128
|
4
|
50
|
|
|
|
25
|
$made = $maker->( \@children ) if $maker; |
129
|
|
|
|
|
|
|
} #/ elsif ( $type =~ /^(AnyOf|AllOf|Tuple)\[(.+)\]$/) |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
elsif ( $type =~ /^Maybe\[(.+)\]$/ ) { |
132
|
0
|
0
|
|
|
|
0
|
my $child = get_coderef_for( $1 ) or return; |
133
|
0
|
|
|
|
|
0
|
$made = _parameterize_Maybe_for( $child ); |
134
|
|
|
|
|
|
|
} |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
elsif ( $type =~ /^InstanceOf\[(.+)\]$/ ) { |
137
|
1
|
|
|
|
|
3
|
my $class = $1; |
138
|
1
|
50
|
|
|
|
6
|
return unless Type::Tiny::XS::Util::is_valid_class_name( $class ); |
139
|
1
|
|
|
|
|
11
|
$made = Type::Tiny::XS::Util::generate_isa_predicate_for( $class ); |
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
elsif ( $type =~ /^HasMethods\[(.+)\]$/ ) { |
143
|
0
|
|
|
|
|
0
|
my $methods = [ sort( split /,/, $1 ) ]; |
144
|
0
|
|
0
|
|
|
0
|
/^[^\W0-9]\w*$/ or return for @$methods; |
145
|
0
|
|
|
|
|
0
|
$made = Type::Tiny::XS::Util::generate_can_predicate_for( $methods ); |
146
|
|
|
|
|
|
|
} |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
# Type::Tiny::Enum > 1.010003 double-quotes its enums |
149
|
|
|
|
|
|
|
elsif ( $type =~ /^Enum\[".*"\]$/ ) { |
150
|
1
|
50
|
|
|
|
2
|
if ( eval { require Type::Parser } ) { |
|
1
|
|
|
|
|
8
|
|
151
|
1
|
|
|
|
|
3
|
my $parsed = Type::Parser::parse( $type ); |
152
|
1
|
50
|
|
|
|
15182
|
if ( $parsed->{type} eq "parameterized" ) { |
153
|
1
|
|
|
|
|
2
|
my @todo = $parsed->{params}; |
154
|
1
|
|
|
|
|
2
|
my @strings; |
155
|
|
|
|
|
|
|
my $bad; |
156
|
1
|
|
|
|
|
3
|
while ( my $todo = shift @todo ) { |
157
|
6
|
100
|
66
|
|
|
25
|
if ( $todo->{type} eq 'list' ) { |
|
|
100
|
33
|
|
|
|
|
|
|
50
|
|
|
|
|
|
158
|
1
|
|
|
|
|
2
|
push @todo, @{ $todo->{list} }; |
|
1
|
|
|
|
|
5
|
|
159
|
|
|
|
|
|
|
} |
160
|
|
|
|
|
|
|
elsif ( $todo->{type} eq "expression" |
161
|
|
|
|
|
|
|
&& $todo->{op}->type eq Type::Parser::COMMA() ) |
162
|
|
|
|
|
|
|
{ |
163
|
2
|
|
|
|
|
12
|
push @todo, $todo->{lhs}, $todo->{rhs}; |
164
|
|
|
|
|
|
|
} |
165
|
|
|
|
|
|
|
elsif ( $todo->{type} eq "primary" && $todo->{token}->type eq "QUOTELIKE" ) { |
166
|
3
|
|
|
|
|
14
|
push @strings, eval( $todo->{token}->spelling ); |
167
|
|
|
|
|
|
|
} |
168
|
|
|
|
|
|
|
else { |
169
|
|
|
|
|
|
|
# Unexpected entry in the parse-tree, bail out |
170
|
0
|
|
|
|
|
0
|
$bad = 1; |
171
|
|
|
|
|
|
|
} |
172
|
|
|
|
|
|
|
} #/ while ( my $todo = shift ...) |
173
|
1
|
50
|
|
|
|
17
|
$made = _parameterize_Enum_for( \@strings ) unless $bad; |
174
|
|
|
|
|
|
|
} #/ if ( $parsed->{type} eq...) |
175
|
|
|
|
|
|
|
} #/ if ( eval { require Type::Parser...}) |
176
|
|
|
|
|
|
|
} #/ elsif ( $type =~ /^Enum\[".*"\]$/) |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
elsif ( $type =~ /^Enum\[(.+)\]$/ ) { |
179
|
2
|
|
|
|
|
12
|
my $strings = [ sort( split /,/, $1 ) ]; |
180
|
2
|
|
|
|
|
9
|
$made = _parameterize_Enum_for( $strings ); |
181
|
|
|
|
|
|
|
} |
182
|
|
|
|
|
|
|
|
183
|
21
|
50
|
|
|
|
65
|
if ( $made ) { |
184
|
18
|
|
|
18
|
|
129
|
no strict qw(refs); |
|
18
|
|
|
|
|
33
|
|
|
18
|
|
|
|
|
7358
|
|
185
|
21
|
|
|
|
|
95
|
my $slot = sprintf( '%s::AUTO::TC%d', __PACKAGE__, ++$id ); |
186
|
21
|
|
|
|
|
63
|
$names{$type} = $slot; |
187
|
21
|
|
|
|
|
49
|
_know( $made, $type ); |
188
|
21
|
|
|
|
|
129
|
*$slot = $made; |
189
|
21
|
|
|
|
|
64
|
return $made; |
190
|
|
|
|
|
|
|
} |
191
|
|
|
|
|
|
|
|
192
|
0
|
|
|
|
|
0
|
return; |
193
|
|
|
|
|
|
|
} #/ sub get_coderef_for |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
sub get_subname_for { |
196
|
0
|
|
|
0
|
1
|
0
|
my $type = $_[0]; |
197
|
0
|
0
|
|
|
|
0
|
get_coderef_for( $type ) unless exists $names{$type}; |
198
|
0
|
|
|
|
|
0
|
$names{$type}; |
199
|
|
|
|
|
|
|
} |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
sub _parse_parameters { |
202
|
6
|
|
|
6
|
|
6391
|
my $got = Type::Parser::parse( @_ ); |
203
|
6
|
50
|
|
|
|
6898
|
$got->{params} or return; |
204
|
6
|
|
|
|
|
15
|
_handle_expr( $got->{params} ); |
205
|
|
|
|
|
|
|
} |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
sub _handle_expr { |
208
|
51
|
|
|
51
|
|
83
|
my $e = shift; |
209
|
|
|
|
|
|
|
|
210
|
51
|
100
|
|
|
|
79
|
if ( $e->{type} eq 'list' ) { |
211
|
11
|
|
|
|
|
12
|
return map _handle_expr( $_ ), @{ $e->{list} }; |
|
11
|
|
|
|
|
36
|
|
212
|
|
|
|
|
|
|
} |
213
|
40
|
100
|
|
|
|
72
|
if ( $e->{type} eq 'parameterized' ) { |
214
|
5
|
|
|
|
|
11
|
my ( $base ) = _handle_expr( $e->{base} ); |
215
|
5
|
|
|
|
|
27
|
my @params = _handle_expr( $e->{params} ); |
216
|
5
|
|
|
|
|
70
|
return sprintf( '%s[%s]', $base, join( q[,], @params ) ); |
217
|
|
|
|
|
|
|
} |
218
|
35
|
100
|
66
|
|
|
76
|
if ( $e->{type} eq 'expression' and $e->{op}->type eq Type::Parser::COMMA() ) { |
219
|
12
|
|
|
|
|
70
|
return _handle_expr( $e->{lhs} ), _handle_expr( $e->{rhs} ); |
220
|
|
|
|
|
|
|
} |
221
|
23
|
50
|
|
|
|
35
|
if ( $e->{type} eq 'primary' ) { |
222
|
23
|
|
|
|
|
39
|
return $e->{token}->spelling; |
223
|
|
|
|
|
|
|
} |
224
|
|
|
|
|
|
|
|
225
|
0
|
|
|
|
|
|
'****'; |
226
|
|
|
|
|
|
|
} #/ sub _handle_expr |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
1; |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
__END__ |