File Coverage

blib/lib/FFI/Build/File/C.pm
Criterion Covered Total %
statement 62 68 91.1
branch 10 14 71.4
condition 4 9 44.4
subroutine 16 16 100.0
pod 2 3 66.6
total 94 110 85.4


line stmt bran cond sub pod time code
1             package FFI::Build::File::C;
2              
3 7     7   101944 use strict;
  7         27  
  7         207  
4 7     7   34 use warnings;
  7         12  
  7         162  
5 7     7   132 use 5.008001;
  7         23  
6 7     7   49 use base qw( FFI::Build::File::Base );
  7         14  
  7         2306  
7 7     7   50 use constant default_suffix => '.c';
  7         13  
  7         500  
8 7     7   41 use constant default_encoding => ':utf8';
  7         12  
  7         305  
9 7     7   50 use Capture::Tiny ();
  7         11  
  7         127  
10 7     7   36 use File::Path ();
  7         51  
  7         171  
11 7     7   3052 use FFI::Build::File::Object;
  7         19  
  7         4957  
12              
13             # ABSTRACT: Class to track C source file in FFI::Build
14             our $VERSION = '0.10'; # VERSION
15              
16              
17             sub accept_suffix
18             {
19 27     27 1 120 (qr/\.c$/)
20             }
21              
22             sub build_item
23             {
24 14     14 1 58 my($self) = @_;
25              
26 14         139 my $oname = $self->basename;
27 14         232 $oname =~ s/\.c(xx|pp)?$//;
28 14         80 $oname .= $self->platform->object_suffix;
29              
30 14         110 my $buildname = '_build';
31 14 100       77 $buildname = $self->build->buildname if $self->build;
32              
33 14         89 my $object = FFI::Build::File::Object->new(
34             [ $self->dirname, $buildname, $oname ],
35             platform => $self->platform,
36             build => $self->build,
37             );
38            
39 14 50 33     85 return $object if -f $object->path && !$object->needs_rebuild($self->_deps);
40            
41 14         88 File::Path::mkpath($object->dirname, { verbose => 0, mode => 0700 });
42              
43 14         112 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 14     14   19714 print "+ @cmd\n";
51 14         606267 system @cmd;
52 14         946 });
53              
54 14 50 33     22300 if($exit || !-f $object->path)
    100 66        
55             {
56 0         0 print $out;
57 0         0 die "error building $object from $self";
58             }
59             elsif($self->build && $self->build->verbose)
60             {
61 10         308 print $out;
62             }
63            
64 14         634 $object;
65             }
66              
67             sub cc
68             {
69 13     13 0 41 my($self) = @_;
70 13         59 $self->platform->cc;
71             }
72              
73             sub _base_args
74             {
75 16     16   56 my($self) = @_;
76 16         72 my @cmd = (
77             $self->cc,
78             $self->platform->cflags,
79             );
80 16 100       99 push @cmd, @{ $self->build->cflags } if $self->build;
  12         46  
81 16         96 push @cmd, $self->platform->extra_system_inc;
82 16         99 @cmd;
83             }
84              
85             sub _deps
86             {
87 2     2   35 my($self) = @_;
88            
89 2 50       9 return $self->path unless $self->platform->cc_mm_works;
90              
91 2         43 my @cmd = (
92             $self->_base_args,
93             '-MM',
94             $self->path,
95             );
96            
97             my($out,$err,$exit) = Capture::Tiny::capture(sub {
98 2     2   3107 print "+ @cmd\n";
99 2         23145 system @cmd;
100 2         215 });
101            
102 2 50       2913 if($exit)
103             {
104 0         0 print $out;
105 0         0 print $err;
106 0         0 warn "error computing dependencies for $self";
107 0         0 return ($self->path);
108             }
109             else
110             {
111 2         30 my(undef, $deps) = split /:/, $out, 2;
112 2         47 $deps =~ s/^\s+//;
113 2         45 $deps =~ s/\s+$//;
114 2         95 return grep !/^\\$/, split /\s+/, $deps;
115             }
116             }
117              
118             1;
119              
120             __END__