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   86225 use strict;
  7         18  
  7         174  
4 7     7   29 use warnings;
  7         12  
  7         140  
5 7     7   109 use 5.008001;
  7         17  
6 7     7   43 use base qw( FFI::Build::File::Base );
  7         11  
  7         1956  
7 7     7   40 use constant default_suffix => '.c';
  7         14  
  7         456  
8 7     7   37 use constant default_encoding => ':utf8';
  7         10  
  7         248  
9 7     7   41 use Capture::Tiny ();
  7         13  
  7         99  
10 7     7   27 use File::Path ();
  7         27  
  7         119  
11 7     7   2605 use FFI::Build::File::Object;
  7         15  
  7         4201  
12              
13             # ABSTRACT: Class to track C source file in FFI::Build
14             our $VERSION = '0.11'; # VERSION
15              
16              
17             sub accept_suffix
18             {
19 27     27 1 97 (qr/\.c$/)
20             }
21              
22             sub build_item
23             {
24 14     14 1 47 my($self) = @_;
25              
26 14         99 my $oname = $self->basename;
27 14         262 $oname =~ s/\.c(xx|pp)?$//;
28 14         72 $oname .= $self->platform->object_suffix;
29              
30 14         64 my $buildname = '_build';
31 14 100       86 $buildname = $self->build->buildname if $self->build;
32              
33 14         84 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     54 return $object if -f $object->path && !$object->needs_rebuild($self->_deps);
40            
41 14         76 File::Path::mkpath($object->dirname, { verbose => 0, mode => 0700 });
42              
43 14         115 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   16219 print "+ @cmd\n";
51 14         583604 system @cmd;
52 14         828 });
53              
54 14 50 33     18530 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         246 print $out;
62             }
63            
64 14         616 $object;
65             }
66              
67             sub cc
68             {
69 13     13 0 27 my($self) = @_;
70 13         48 $self->platform->cc;
71             }
72              
73             sub _base_args
74             {
75 16     16   45 my($self) = @_;
76 16         93 my @cmd = (
77             $self->cc,
78             $self->platform->cflags,
79             );
80 16 100       85 push @cmd, @{ $self->build->cflags } if $self->build;
  12         43  
81 16         45 push @cmd, $self->platform->extra_system_inc;
82 16         177 @cmd;
83             }
84              
85             sub _deps
86             {
87 2     2   43 my($self) = @_;
88            
89 2 50       9 return $self->path unless $self->platform->cc_mm_works;
90              
91 2         38 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   2492 print "+ @cmd\n";
99 2         17668 system @cmd;
100 2         201 });
101            
102 2 50       2591 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         23 my(undef, $deps) = split /:/, $out, 2;
112 2         29 $deps =~ s/^\s+//;
113 2         42 $deps =~ s/\s+$//;
114 2         81 return grep !/^\\$/, split /\s+/, $deps;
115             }
116             }
117              
118             1;
119              
120             __END__