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   70875 use strict;
  7         25  
  7         248  
4 7     7   37 use warnings;
  7         14  
  7         179  
5 7     7   125 use 5.008001;
  7         25  
6 7     7   50 use base qw( FFI::Build::File::Base );
  7         14  
  7         2292  
7 7     7   48 use constant default_suffix => '.c';
  7         14  
  7         513  
8 7     7   40 use constant default_encoding => ':utf8';
  7         14  
  7         330  
9 7     7   42 use Capture::Tiny ();
  7         13  
  7         137  
10 7     7   38 use File::Path ();
  7         38  
  7         122  
11 7     7   3040 use FFI::Build::File::Object;
  7         20  
  7         5065  
12              
13             # ABSTRACT: Class to track C source file in FFI::Build
14             our $VERSION = '0.12'; # VERSION
15              
16              
17             sub accept_suffix
18             {
19 27     27 1 136 (qr/\.c$/)
20             }
21              
22             sub build_item
23             {
24 14     14 1 58 my($self) = @_;
25              
26 14         71 my $oname = $self->basename;
27 14         274 $oname =~ s/\.c(xx|pp)?$//;
28 14         83 $oname .= $self->platform->object_suffix;
29              
30 14         77 my $buildname = '_build';
31 14 100       86 $buildname = $self->build->buildname if $self->build;
32              
33 14         91 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     73 return $object if -f $object->path && !$object->needs_rebuild($self->_deps);
40            
41 14         108 File::Path::mkpath($object->dirname, { verbose => 0, mode => 0700 });
42              
43 14         129 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   21164 print "+ @cmd\n";
51 14         630667 system @cmd;
52 14         1066 });
53              
54 14 50 33     26373 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         382 print $out;
62             }
63            
64 14         789 $object;
65             }
66              
67             sub cc
68             {
69 13     13 0 46 my($self) = @_;
70 13         82 $self->platform->cc;
71             }
72              
73             sub _base_args
74             {
75 16     16   58 my($self) = @_;
76 16         68 my @cmd = (
77             $self->cc,
78             $self->platform->cflags,
79             );
80 16 100       105 push @cmd, @{ $self->build->cflags } if $self->build;
  12         58  
81 16         386 push @cmd, $self->platform->extra_system_inc;
82 16         109 @cmd;
83             }
84              
85             sub _deps
86             {
87 2     2   29 my($self) = @_;
88            
89 2 50       14 return $self->path unless $self->platform->cc_mm_works;
90              
91 2         46 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   2774 print "+ @cmd\n";
99 2         18856 system @cmd;
100 2         180 });
101            
102 2 50       3212 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         31 my(undef, $deps) = split /:/, $out, 2;
112 2         46 $deps =~ s/^\s+//;
113 2         40 $deps =~ s/\s+$//;
114 2         91 return grep !/^\\$/, split /\s+/, $deps;
115             }
116             }
117              
118             1;
119              
120             __END__