File Coverage

blib/lib/FFI/C/Array.pm
Criterion Covered Total %
statement 32 36 88.8
branch 5 6 83.3
condition 7 9 77.7
subroutine 12 15 80.0
pod 3 3 100.0
total 59 69 85.5


line stmt bran cond sub pod time code
1             package FFI::C::Array;
2              
3 4     4   28 use strict;
  4         8  
  4         114  
4 4     4   31 use warnings;
  4         11  
  4         90  
5 4     4   18 use FFI::C::FFI ();
  4         17  
  4         203  
6             use overload
7             '@{}' => \&tie,
8 165     165   785 bool => sub { 1 },
9 4     4   26 fallback => 1;
  4         8  
  4         47  
10              
11             # ABSTRACT: Array instance for FFI
12             our $VERSION = '0.15'; # VERSION
13              
14              
15             sub get
16             {
17 78     78 1 6537 my($self, $index) = @_;
18 78 50       160 Carp::croak("Negative array index") if $index < 0;
19 78 100 100     362 Carp::croak("OOB array index") if $self->{count} && $index >= $self->{count};
20 77         134 my $member = $self->{def}->{members}->{member};
21 77         195 my $ptr = $self->{ptr} + $member->size * $index;
22 77   66     260 $member->create($ptr,$self->{owner} || $self);
23             }
24              
25 21     21 1 7156 sub count { shift->{count} }
26              
27             sub tie
28             {
29 9     9 1 1800 my @a;
30 9         34 CORE::tie @a, 'FFI::C::Array', shift;
31 9         78 \@a;
32             }
33              
34             sub DESTROY
35             {
36 10     10   1099 my($self) = @_;
37 10 100 66     63 if($self->{ptr} && !$self->{owner})
38             {
39 5         73 FFI::C::FFI::free(delete $self->{ptr});
40             }
41             }
42              
43             sub TIEARRAY
44             {
45 9     9   23 my($class, $array) = @_;
46 9         24 $array;
47             }
48              
49             sub FETCH
50             {
51 41     41   66 my($self, $index) = @_;
52 41         80 $self->get($index);
53             }
54              
55             sub STORE
56             {
57 0     0   0 Carp::croak("Cannot set");
58             }
59              
60             sub FETCHSIZE
61             {
62 16     16   131 my($self) = @_;
63 16         42 $self->count;
64             }
65              
66             sub STORESIZE
67             {
68 0     0     my($self) = @_;
69 0           $self->count;
70             }
71              
72             sub CLEAR
73             {
74 0     0     Carp::croak("Cannot clear");
75             }
76              
77             1;
78              
79             __END__