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   182667 use strict;
  10         23  
  10         251  
4 10     10   40 use warnings;
  10         19  
  10         228  
5 10     10   174 use 5.008004;
  10         31  
6 10     10   386 use parent qw( FFI::Build::File::Base );
  10         265  
  10         59  
7 10     10   579 use constant default_suffix => '.c';
  10         104  
  10         630  
8 10     10   61 use constant default_encoding => ':utf8';
  10         14  
  10         361  
9 10     10   47 use Capture::Tiny ();
  10         22  
  10         155  
10 10     10   43 use File::Path ();
  10         18  
  10         166  
11 10     10   3024 use FFI::Build::File::Object;
  10         21  
  10         9658  
12              
13             # ABSTRACT: Class to track C source file in FFI::Build
14             our $VERSION = '2.07'; # VERSION
15              
16              
17             sub accept_suffix
18             {
19 73     73 1 245 (qr/\.(c|i)$/)
20             }
21              
22             sub build_item
23             {
24 32     32 1 93 my($self) = @_;
25              
26 32         149 my $oname = $self->basename;
27 32         340 $oname =~ s/\.(c(xx|pp)|i)?$//;
28 32         151 $oname .= $self->platform->object_suffix;
29              
30 32         161 my $buildname = '_build';
31 32 100       150 $buildname = $self->build->buildname if $self->build;
32              
33 32         178 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     143 return $object if -f $object->path && !$object->needs_rebuild($self->_deps);
40              
41 32         729 File::Path::mkpath($object->dirname, { verbose => 0, mode => oct(700) });
42              
43 32         232 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   33022 $self->platform->run(@cmd);
51 32         1362 });
52              
53 32 100 66     42202 if($exit || !-f $object->path)
    100 100        
    100 66        
54             {
55 1         60 print $out;
56 1         17 die "error building $object from $self";
57             }
58             elsif($self->build && $self->build->verbose >= 2)
59             {
60 16         688 print $out;
61             }
62             elsif($self->build && $self->build->verbose >= 1)
63             {
64 11         48 print "CC @{[ $self->path ]}\n";
  11         60  
65             }
66              
67 31         1523 $object;
68             }
69              
70             sub cc
71             {
72 31     31 0 72 my($self) = @_;
73 31         100 $self->platform->cc;
74             }
75              
76             sub _base_args
77             {
78 34     34   90 my($self) = @_;
79 34         134 my @cmd = ($self->cc);
80 34 100       1030 push @cmd, $self->build->cflags_I if $self->build;
81 34         100 push @cmd, $self->platform->ccflags;
82 34 100       112 push @cmd, @{ $self->build->cflags } if $self->build;
  30         85  
83 34         138 @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   32 my($self) = @_;
144              
145 2 50       11 return $self->path unless $self->platform->cc_mm_works;
146              
147 2         78 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   2501 $self->platform->run(@cmd);
155 2         197 });
156              
157 2 50       2264 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         38 $out =~ s/^\+.*\n//; # remove the command line
167             # which on windows could have an confusing :
168 2         26 my(undef, $deps) = split /:/, $out, 2;
169 2         15 $deps =~ s/^\s+//;
170 2         25 $deps =~ s/\s+$//;
171 2         78 return grep !/^\\$/, split /\s+/, $deps;
172             }
173             }
174              
175             1;
176              
177             __END__