line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package FFI::Platypus::TypeParser; |
2
|
|
|
|
|
|
|
|
3
|
52
|
|
|
52
|
|
31225
|
use strict; |
|
52
|
|
|
|
|
104
|
|
|
52
|
|
|
|
|
1216
|
|
4
|
52
|
|
|
52
|
|
216
|
use warnings; |
|
52
|
|
|
|
|
85
|
|
|
52
|
|
|
|
|
963
|
|
5
|
52
|
|
|
52
|
|
659
|
use 5.008004; |
|
52
|
|
|
|
|
164
|
|
6
|
52
|
|
|
52
|
|
320
|
use List::Util 1.45 qw( uniqstr ); |
|
52
|
|
|
|
|
909
|
|
|
52
|
|
|
|
|
3142
|
|
7
|
52
|
|
|
52
|
|
308
|
use Carp qw( croak ); |
|
52
|
|
|
|
|
80
|
|
|
52
|
|
|
|
|
24669
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
# ABSTRACT: FFI Type Parser |
10
|
|
|
|
|
|
|
our $VERSION = '2.07'; # VERSION |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
# The TypeParser and Type classes are used internally ONLY and |
14
|
|
|
|
|
|
|
# are not to be exposed to the user. External users should |
15
|
|
|
|
|
|
|
# not under any circumstances rely on the implementation of |
16
|
|
|
|
|
|
|
# these classes. |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
sub new |
19
|
|
|
|
|
|
|
{ |
20
|
425
|
|
|
425
|
0
|
62108
|
my($class) = @_; |
21
|
425
|
|
|
|
|
1468
|
my $self = bless { types => {}, type_map => {}, abi => -1 }, $class; |
22
|
425
|
|
|
|
|
1345
|
$self->build; |
23
|
425
|
|
|
|
|
2694
|
$self; |
24
|
|
|
|
|
|
|
} |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
425
|
0
|
|
sub build {} |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
our %basic_type; |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
# this just checks if the underlying libffi/platypus implementation |
31
|
|
|
|
|
|
|
# has the basic type. It is used mainly to verify that exotic types |
32
|
|
|
|
|
|
|
# like longdouble and complex_float are available before the test |
33
|
|
|
|
|
|
|
# suite tries to use them. |
34
|
|
|
|
|
|
|
sub have_type |
35
|
|
|
|
|
|
|
{ |
36
|
24513
|
|
|
24513
|
0
|
78324
|
my(undef, $name) = @_; |
37
|
24513
|
|
|
|
|
48804
|
!!$basic_type{$name}; |
38
|
|
|
|
|
|
|
} |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
sub create_type_custom |
41
|
|
|
|
|
|
|
{ |
42
|
207
|
|
|
207
|
0
|
699
|
my($self, $name, @rest) = @_; |
43
|
207
|
100
|
|
|
|
464
|
$name = 'opaque' unless defined $name; |
44
|
207
|
|
|
|
|
472
|
my $type = $self->parse($name); |
45
|
207
|
100
|
|
|
|
828
|
unless($type->is_customizable) |
46
|
|
|
|
|
|
|
{ |
47
|
2
|
|
|
|
|
274
|
croak "$name is not a legal basis for a custom type" |
48
|
|
|
|
|
|
|
} |
49
|
205
|
|
|
|
|
1219
|
$self->_create_type_custom($type, @rest); |
50
|
|
|
|
|
|
|
} |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
# this is the type map provided by the language plugin, if any |
53
|
|
|
|
|
|
|
# in addition to the basic types (which map to themselves). |
54
|
|
|
|
|
|
|
sub type_map |
55
|
|
|
|
|
|
|
{ |
56
|
3504
|
|
|
3504
|
0
|
4947
|
my($self, $new) = @_; |
57
|
|
|
|
|
|
|
|
58
|
3504
|
100
|
|
|
|
5448
|
if(defined $new) |
59
|
|
|
|
|
|
|
{ |
60
|
358
|
|
|
|
|
906
|
$self->{type_map} = $new; |
61
|
|
|
|
|
|
|
} |
62
|
|
|
|
|
|
|
|
63
|
3504
|
|
|
|
|
9868
|
$self->{type_map}; |
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
# this stores the types that have been mentioned so far. It also |
67
|
|
|
|
|
|
|
# usually includes aliases. |
68
|
|
|
|
|
|
|
sub types |
69
|
|
|
|
|
|
|
{ |
70
|
7784
|
|
|
7784
|
0
|
23811
|
shift->{types}; |
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
# The type parser needs to know the ABI when creating closures |
74
|
|
|
|
|
|
|
sub abi |
75
|
|
|
|
|
|
|
{ |
76
|
116
|
|
|
116
|
0
|
3517
|
my($self, $new) = @_; |
77
|
116
|
100
|
|
|
|
249
|
$self->{abi} = $new if defined $new; |
78
|
116
|
|
|
|
|
653
|
$self->{abi}; |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
{ |
82
|
|
|
|
|
|
|
my %store; |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
foreach my $name (keys %basic_type) |
85
|
|
|
|
|
|
|
{ |
86
|
|
|
|
|
|
|
my $type_code = $basic_type{$name}; |
87
|
|
|
|
|
|
|
$store{basic}->{$name} = __PACKAGE__->create_type_basic($type_code); |
88
|
|
|
|
|
|
|
$store{ptr}->{$name} = __PACKAGE__->create_type_pointer($type_code); |
89
|
|
|
|
|
|
|
$store{rev}->{$type_code} = $name; |
90
|
|
|
|
|
|
|
} |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
sub global_types |
93
|
|
|
|
|
|
|
{ |
94
|
4799
|
|
|
4799
|
0
|
18631
|
\%store; |
95
|
|
|
|
|
|
|
} |
96
|
|
|
|
|
|
|
} |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
# list all the types that this type parser knows about, including |
99
|
|
|
|
|
|
|
# those provided by the language plugin (if any), those defined |
100
|
|
|
|
|
|
|
# by the user, and the basic types that everyone gets. |
101
|
|
|
|
|
|
|
sub list_types |
102
|
|
|
|
|
|
|
{ |
103
|
3
|
|
|
3
|
0
|
6
|
my($self) = @_; |
104
|
3
|
|
|
|
|
4
|
uniqstr( ( keys %{ $self->type_map } ), ( keys %{ $self->types } ) ); |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
6
|
|
105
|
|
|
|
|
|
|
} |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
our @CARP_NOT = qw( FFI::Platypus ); |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
1; |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
__END__ |