File Coverage

blib/lib/FFI/Build/File/C.pm
Criterion Covered Total %
statement 66 97 68.0
branch 15 30 50.0
condition 8 18 44.4
subroutine 16 19 84.2
pod 2 4 50.0
total 107 168 63.6


line stmt bran cond sub pod time code
1             package FFI::Build::File::C;
2              
3 10     10   235456 use strict;
  10         30  
  10         315  
4 10     10   53 use warnings;
  10         24  
  10         292  
5 10     10   192 use 5.008004;
  10         33  
6 10     10   461 use parent qw( FFI::Build::File::Base );
  10         299  
  10         66  
7 10     10   741 use constant default_suffix => '.c';
  10         25  
  10         751  
8 10     10   66 use constant default_encoding => ':utf8';
  10         28  
  10         463  
9 10     10   55 use Capture::Tiny ();
  10         30  
  10         191  
10 10     10   62 use File::Path ();
  10         20  
  10         226  
11 10     10   3779 use FFI::Build::File::Object;
  10         27  
  10         12392  
12              
13             # ABSTRACT: Class to track C source file in FFI::Build
14             our $VERSION = '2.08'; # VERSION
15              
16              
17             sub accept_suffix
18             {
19 73     73 1 409 (qr/\.(c|i)$/)
20             }
21              
22             sub build_item
23             {
24 32     32 1 143 my($self) = @_;
25              
26 32         258 my $oname = $self->basename;
27 32         542 $oname =~ s/\.(c(xx|pp)|i)?$//;
28 32         224 $oname .= $self->platform->object_suffix;
29              
30 32         229 my $buildname = '_build';
31 32 100       226 $buildname = $self->build->buildname if $self->build;
32              
33 32         234 my $object = FFI::Build::File::Object->new(
34             [ $self->dirname, $buildname, $oname ],
35             platform => $self->platform,
36             build => $self->build,
37             );
38              
39 32 50 33     206 return $object if -f $object->path && !$object->needs_rebuild($self->_deps);
40              
41 32         282 File::Path::mkpath($object->dirname, { verbose => 0, mode => oct(700) });
42              
43 32         412 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 32     32   43139 $self->platform->run(@cmd);
51 32         1869 });
52              
53 32 100 66     61349 if($exit || !-f $object->path)
    100 100        
    100 66        
54             {
55 1         66 print $out;
56 1         22 die "error building $object from $self";
57             }
58             elsif($self->build && $self->build->verbose >= 2)
59             {
60 16         765 print $out;
61             }
62             elsif($self->build && $self->build->verbose >= 1)
63             {
64 11         84 print "CC @{[ $self->path ]}\n";
  11         130  
65             }
66              
67 31         1939 $object;
68             }
69              
70             sub cc
71             {
72 31     31 0 88 my($self) = @_;
73 31         127 $self->platform->cc;
74             }
75              
76             sub _base_args
77             {
78 34     34   139 my($self) = @_;
79 34         145 my @cmd = ($self->cc);
80 34 100       1223 push @cmd, $self->build->cflags_I if $self->build;
81 34         150 push @cmd, $self->platform->ccflags;
82 34 100       156 push @cmd, @{ $self->build->cflags } if $self->build;
  30         158  
83 34         207 @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 2     2   38 my($self) = @_;
144              
145 2 50       9 return $self->path unless $self->platform->cc_mm_works;
146              
147 2         120 my @cmd = (
148             $self->_base_args,
149             '-MM',
150             $self->path,
151             );
152              
153             my($out,$err,$exit) = Capture::Tiny::capture(sub {
154 2     2   2866 $self->platform->run(@cmd);
155 2         183 });
156              
157 2 50       2400 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 2         96 $out =~ s/^\+.*\n//; # remove the command line
167             # which on windows could have an confusing :
168 2         18 my(undef, $deps) = split /:/, $out, 2;
169 2         33 $deps =~ s/^\s+//;
170 2         45 $deps =~ s/\s+$//;
171 2         108 return grep !/^\\$/, split /\s+/, $deps;
172             }
173             }
174              
175             1;
176              
177             __END__