File Coverage

lib/FFI/Build/File/C.pm
Criterion Covered Total %
statement 66 97 68.0
branch 15 30 50.0
condition 9 18 50.0
subroutine 16 19 84.2
pod 2 4 50.0
total 108 168 64.2


line stmt bran cond sub pod time code
1             package FFI::Build::File::C;
2              
3 12     12   191109 use strict;
  12         24  
  12         453  
4 12     12   59 use warnings;
  12         21  
  12         703  
5 12     12   215 use 5.008004;
  12         94  
6 12     12   390 use parent qw( FFI::Build::File::Base );
  12         313  
  12         95  
7 12     12   1070 use constant default_suffix => '.c';
  12         27  
  12         1072  
8 12     12   70 use constant default_encoding => ':utf8';
  12         19  
  12         684  
9 12     12   71 use Capture::Tiny ();
  12         19  
  12         267  
10 12     12   51 use File::Path ();
  12         18  
  12         233  
11 12     12   5654 use FFI::Build::File::Object;
  12         45  
  12         18173  
12              
13             # ABSTRACT: Class to track C source file in FFI::Build
14             our $VERSION = '2.11'; # VERSION
15              
16              
17             sub accept_suffix
18             {
19 103     103 1 387 (qr/\.(c|i)$/)
20             }
21              
22             sub build_item
23             {
24 61     61 1 197 my($self) = @_;
25              
26 61         328 my $oname = $self->basename;
27 61         739 $oname =~ s/\.(c(xx|pp)|i)?$//;
28 61         440 $oname .= $self->platform->object_suffix;
29              
30 61         321 my $buildname = '_build';
31 61 100       246 $buildname = $self->build->buildname if $self->build;
32              
33 61         393 my $object = FFI::Build::File::Object->new(
34             [ $self->dirname, $buildname, $oname ],
35             platform => $self->platform,
36             build => $self->build,
37             );
38              
39 61 50 66     286 return $object if -f $object->path && !$object->needs_rebuild($self->_deps);
40              
41 61         409 File::Path::mkpath($object->dirname, { verbose => 0, mode => oct(700) });
42              
43 61         742 my @cmd = (
44             $self->_base_args,
45             -c => $self->path,
46             $self->platform->flag_object_output($object->path),
47             );
48              
49             my($out, $exit) = Capture::Tiny::capture_merged(sub {
50 61     61   109460 $self->platform->run(@cmd);
51 61         7221 });
52              
53 61 100 66     93553 if($exit || !-f $object->path)
    100 100        
    100 66        
54             {
55 1         64 print $out;
56 1         27 die "error building $object from $self";
57             }
58             elsif($self->build && $self->build->verbose >= 2)
59             {
60 14         701 print $out;
61             }
62             elsif($self->build && $self->build->verbose >= 1)
63             {
64 43         133 print "CC @{[ $self->path ]}\n";
  43         217  
65             }
66              
67 60         2345 $object;
68             }
69              
70             sub cc
71             {
72 65     65 0 182 my($self) = @_;
73 65         255 $self->platform->cc;
74             }
75              
76             sub _base_args
77             {
78 65     65   202 my($self) = @_;
79 65         348 my @cmd = ($self->cc);
80 65 100       277 push @cmd, $self->build->cflags_I if $self->build;
81 65         189 push @cmd, $self->platform->ccflags;
82 65 100       290 push @cmd, @{ $self->build->cflags } if $self->build;
  62         171  
83 65         443 @cmd;
84             }
85              
86             sub _base_args_cpp
87             {
88 0     0   0 my($self) = @_;
89 0         0 my @cmd = ($self->platform->cpp);
90 0 0       0 push @cmd, $self->build->cflags_I if $self->build;
91 0         0 push @cmd, grep /^-[DI]/, $self->platform->ccflags;
92 0 0       0 push @cmd, grep /^-D/, @{ $self->build->cflags } if $self->build;
  0         0  
93 0         0 @cmd;
94             }
95              
96             sub build_item_cpp
97             {
98 0     0 0 0 my($self) = @_;
99              
100 0         0 my $oname = $self->basename;
101 0         0 $oname =~ s/\.(c(xx|pp)|i)$?$//;
102 0         0 $oname .= '.i';
103              
104 0         0 my $buildname = '_build';
105 0 0       0 $buildname = $self->build->buildname if $self->build;
106              
107 0         0 my $ifile = FFI::Build::File::C->new(
108             [ $self->dirname, $buildname, $oname ],
109             platform => $self->platform,
110             build => $self->build,
111             );
112              
113 0         0 File::Path::mkpath($ifile->dirname, { verbose => 0, mode => oct(700) });
114              
115 0         0 my @cmd = (
116             $self->_base_args_cpp,
117             $self->path,
118             );
119              
120             my($out, $err, $exit) = Capture::Tiny::capture(sub {
121 0     0   0 $self->platform->run(@cmd);
122 0         0 });
123              
124 0 0       0 if($exit)
125             {
126 0 0 0     0 print "[out]\n$out\n" if defined $out && $out ne '';
127 0 0 0     0 print "[err]\n$err\n" if defined $err && $err ne '';
128 0         0 die "error building $ifile from $self";
129             }
130             else
131             {
132 0         0 my $fh;
133 0         0 open($fh, '>', $ifile->path);
134 0         0 print $fh $out;
135 0         0 close $fh;
136             }
137              
138 0         0 $ifile;
139             }
140              
141             sub _deps
142             {
143 4     4   99 my($self) = @_;
144              
145 4 50       15 return $self->path unless $self->platform->cc_mm_works;
146              
147 4         40 my @cmd = (
148             $self->_base_args,
149             '-MM',
150             $self->path,
151             );
152              
153             my($out,$err,$exit) = Capture::Tiny::capture(sub {
154 4     4   29135 $self->platform->run(@cmd);
155 4         335 });
156              
157 4 50       6120 if($exit)
158             {
159 0         0 print $out;
160 0         0 print $err;
161 0         0 warn "error computing dependencies for $self";
162 0         0 return ($self->path);
163             }
164             else
165             {
166 4         93 $out =~ s/^\+.*\n//; # remove the command line
167             # which on windows could have an confusing :
168 4         45 my(undef, $deps) = split /:/, $out, 2;
169 4         45 $deps =~ s/^\s+//;
170 4         51 $deps =~ s/\s+$//;
171 4         254 return grep !/^\\$/, split /\s+/, $deps;
172             }
173             }
174              
175             1;
176              
177             __END__