File Coverage

blib/lib/Test/CChecker.pm
Criterion Covered Total %
statement 70 98 71.4
branch 13 32 40.6
condition 7 19 36.8
subroutine 16 20 80.0
pod 7 7 100.0
total 113 176 64.2


line stmt bran cond sub pod time code
1             package Test::CChecker;
2              
3 2     2   70170 use strict;
  2         14  
  2         60  
4 2     2   10 use warnings;
  2         3  
  2         55  
5 2     2   10 use base qw( Test::Builder::Module );
  2         4  
  2         284  
6 2     2   1025 use ExtUtils::CChecker;
  2         166532  
  2         79  
7 2     2   1035 use Capture::Tiny qw( capture_merged );
  2         8609  
  2         126  
8 2     2   15 use Text::ParseWords qw( shellwords );
  2         4  
  2         175  
9 2     2   1880 use Env qw( @LD_LIBRARY_PATH );
  2         5338  
  2         13  
10 2     2   339 use File::Spec;
  2         4  
  2         48  
11 2     2   993 use FindBin ();
  2         2188  
  2         46  
12 2     2   19 use File::Temp ();
  2         10  
  2         40  
13 2     2   17 use Scalar::Util qw( blessed );
  2         5  
  2         2197  
14              
15             our @EXPORT = qw(
16             cc
17             compile_ok
18             compile_run_ok
19             compile_with_alien
20             compile_output_to_nowhere
21             compile_output_to_diag
22             compile_output_to_note
23             );
24              
25             my $warn_deprecated = do {
26              
27             my $warned = 0;
28              
29             sub
30             {
31             return if $warned++;
32             my $tb = __PACKAGE__->builder;
33             $tb->diag('');
34             $tb->diag('');
35             $tb->diag('');
36             $tb->diag(' ********************************************* ');
37             $tb->diag(' * WARNING: * ');
38             $tb->diag(' * Test::CChecker has been deprecated! * ');
39             $tb->diag(' * Please use Test::Alien instead. * ');
40             $tb->diag(' ********************************************* ');
41             $tb->diag('');
42             $tb->diag('');
43             }
44             };
45              
46             # ABSTRACT: Test-time utilities for checking C headers, libraries, or OS features (DEPRECATED)
47             our $VERSION = '0.10'; # VERSION
48              
49              
50             do {
51             my $cc;
52             sub cc ()
53             {
54 6     6 1 4203 $warn_deprecated->();
55 6   66     325 $cc ||= ExtUtils::CChecker->new( quiet => 0 );
56             }
57             };
58              
59              
60             my $output = '';
61              
62             sub compile_run_ok ($;$)
63             {
64 2     2 1 46788 $warn_deprecated->();
65 2         15 my($args, $message) = @_;
66 2   50     9 $message ||= "compile ok";
67 2         7 my $cc = cc();
68 2         20 my $tb = __PACKAGE__->builder;
69            
70 2         34 my $ok;
71 2 100   2   163 my $out = capture_merged { $ok = $cc->try_compile_run(ref($args) eq 'HASH' ? %$args : $args) };
  2         6638  
72            
73 2         130867 $tb->ok($ok, $message);
74 2 50 33     2453 if(!$ok || $output eq 'diag')
    50          
75             {
76 0         0 $tb->diag($out);
77             }
78             elsif($output eq 'note')
79             {
80 0         0 $tb->note($out);
81             }
82            
83 2         33 $ok;
84             }
85              
86              
87             sub compile_ok ($;$)
88             {
89 2     2 1 4659 $warn_deprecated->();
90 2         10 my($args, $message) = @_;
91 2   50     17 $message ||= "compile ok";
92 2 100       25 $args = ref $args ? $args : { source => $args };
93 2         21 my $cc = cc();
94 2         30 my $tb = __PACKAGE__->builder;
95              
96 2         49 my($fh, $filename) = File::Temp::tempfile("ccheckerXXXXX", SUFFIX => '.c');
97 2         1231 print $fh $args->{source};
98 2         76 close $fh;
99 2         9 my $obj;
100 2         11 my %compile = ( source => $filename );
101 2 100       29 $compile{extra_compiler_flags} = $args->{extra_compiler_flags} if defined $args->{extra_compiler_flags};
102 2         12 my $err;
103 2     2   221 my $out = capture_merged { $obj = eval { $cc->compile(%compile) }; $err = $@ };
  2         2880  
  2         22  
  2         51906  
104            
105 2         3136 my $ok = !!$obj;
106 2 50       139 unlink $filename if $ok;
107 2 50 33     140 unlink $obj if defined $obj && -f $obj;
108 2         63 $tb->ok($ok, $message);
109 2 50 33     2834 if(!$ok || $output eq 'diag')
    50          
110             {
111 0         0 $tb->diag($out);
112             }
113             elsif($output eq 'note')
114             {
115 0         0 $tb->note($out);
116             }
117            
118 2 50       15 $tb->diag($err) if $err;
119            
120 2         36 $ok;
121             }
122              
123              
124             sub compile_with_alien ($)
125             {
126 0     0 1   $warn_deprecated->();
127 0           my $alien = shift;
128 0 0         $alien = $alien->new unless ref $alien;
129              
130 0 0         if($alien->can('dist_dir'))
131             {
132 0           my $dir = eval { File::Spec->catdir($alien->dist_dir, 'lib') };
  0            
133 0 0 0       unshift @LD_LIBRARY_PATH, $dir if defined $dir && -d $dir;
134             }
135            
136 0           my $tdir = File::Spec->catdir($FindBin::Bin, File::Spec->updir, '_test');
137 0 0         if(-d $tdir)
138             {
139             cc->push_extra_compiler_flags(map {
140 0 0         /^-I(.*)$/ ? ("-I".File::Spec->catdir($tdir, $1), $_) : ($_)
  0            
141             } shellwords $alien->cflags);
142             cc->push_extra_linker_flags(map {
143 0 0         /^-L(.*)$/ ? ( map { push @LD_LIBRARY_PATH, $_; "-L$_" } File::Spec->catdir($tdir, $1), $_) : ($_)
  0            
  0            
  0            
144             } shellwords $alien->libs);
145             }
146             else
147             {
148 0           cc->push_extra_compiler_flags(shellwords $alien->cflags);
149 0           cc->push_extra_linker_flags(shellwords $alien->libs);
150             }
151              
152 0           return;
153             }
154              
155              
156             sub compile_output_to_nowhere ()
157             {
158 0     0 1   $warn_deprecated->();
159 0           $output = '';
160             }
161              
162              
163             sub compile_output_to_diag ()
164             {
165 0     0 1   $warn_deprecated->();
166 0           $output = 'diag';
167             }
168              
169              
170             sub compile_output_to_note ()
171             {
172 0     0 1   $warn_deprecated->();
173 0           $output = 'note';
174             }
175              
176             1;
177              
178             __END__