File Coverage

blib/lib/FFI/Platypus/TypeParser.pm
Criterion Covered Total %
statement 39 39 100.0
branch 8 8 100.0
condition n/a
subroutine 14 14 100.0
pod 0 9 0.0
total 61 70 87.1


line stmt bran cond sub pod time code
1             package FFI::Platypus::TypeParser;
2              
3 52     52   48242 use strict;
  52         180  
  52         1954  
4 52     52   349 use warnings;
  52         98  
  52         3904  
5 52     52   893 use 5.008004;
  52         184  
6 52     52   305 use List::Util 1.45 qw( uniqstr );
  52         1193  
  52         4619  
7 52     52   361 use Carp qw( croak );
  52         110  
  52         34318  
8              
9             # ABSTRACT: FFI Type Parser
10             our $VERSION = '2.11'; # 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 423     423 0 915127 my($class) = @_;
21 423         2600 my $self = bless { types => {}, type_map => {}, abi => -1 }, $class;
22 423         1971 $self->build;
23 423         4028 $self;
24             }
25              
26       423 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 24371     24371 0 117640 my(undef, $name) = @_;
37 24371         60333 !!$basic_type{$name};
38             }
39              
40             sub create_type_custom
41             {
42 207     207 0 1020 my($self, $name, @rest) = @_;
43 207 100       593 $name = 'opaque' unless defined $name;
44 207         613 my $type = $self->parse($name);
45 207 100       1163 unless($type->is_customizable)
46             {
47 2         467 croak "$name is not a legal basis for a custom type"
48             }
49 205         1495 $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 3463     3463 0 6500 my($self, $new) = @_;
57              
58 3463 100       10876 if(defined $new)
59             {
60 356         1580 $self->{type_map} = $new;
61             }
62              
63 3463         14239 $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 7723     7723 0 31785 shift->{types};
71             }
72              
73             # The type parser needs to know the ABI when creating closures
74             sub abi
75             {
76 116     116 0 5088 my($self, $new) = @_;
77 116 100       393 $self->{abi} = $new if defined $new;
78 116         820 $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 4786     4786 0 25494 \%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 10 my($self) = @_;
104 3         8 uniqstr( ( keys %{ $self->type_map } ), ( keys %{ $self->types } ) );
  3         15  
  3         15  
105             }
106              
107             our @CARP_NOT = qw( FFI::Platypus );
108              
109             1;
110              
111             __END__