File Coverage

blib/lib/Module/Build/XSUtil.pm
Criterion Covered Total %
statement 23 162 14.2
branch 0 82 0.0
condition 0 36 0.0
subroutine 8 23 34.7
pod 0 4 0.0
total 31 307 10.1


line stmt bran cond sub pod time code
1             package Module::Build::XSUtil;
2 1     1   646 use 5.008005;
  1         3  
3 1     1   4 use strict;
  1         1  
  1         18  
4 1     1   3 use warnings;
  1         2  
  1         22  
5 1     1   4 use Config;
  1         1  
  1         30  
6 1     1   412 use Module::Build;
  1         65425  
  1         35  
7 1     1   10 use File::Basename;
  1         3  
  1         81  
8 1     1   6 use File::Path;
  1         2  
  1         1514  
9             our @ISA = qw(Module::Build);
10              
11             our $VERSION = "0.18";
12              
13             __PACKAGE__->add_property( 'ppport_h_path' => undef );
14             __PACKAGE__->add_property( 'xshelper_h_path' => undef );
15              
16             sub new {
17 0     0 0   my $invocant = shift;
18 0   0       my $class = ref($invocant) || $invocant;
19 0           my %args = @_;
20              
21 0           my $self = $class->SUPER::new(%args);
22 0 0 0       return $self if $self->pureperl_only && $self->allow_pureperl;
23              
24 0 0         if ( !defined $args{cc_warnings} ) {
25 0           $args{cc_warnings} = 1;
26             }
27              
28 0 0         unless ( $self->have_c_compiler() ) {
29 0           warn "This distribution requires a C compiler, but it's not available, stopped.\n";
30 0           exit -1;
31             }
32              
33             # cleanup options
34 0 0         if ( $^O eq 'cygwin' ) {
35 0           $self->add_to_cleanup('*.stackdump');
36             }
37              
38             # debugging options
39 0 0         if ( $self->_xs_debugging() ) {
40 0 0         if ( $self->_is_msvc() ) {
41 0           $self->_add_extra_compiler_flags('-Zi');
42             }
43             else {
44 0           $self->_add_extra_compiler_flags(qw/-g -ggdb -g3/);
45             }
46 0           $self->_add_extra_compiler_flags('-DXS_ASSERT');
47             }
48              
49             # c++ options
50 0 0         if ( $args{needs_compiler_cpp} ) {
51 0           require ExtUtils::CBuilder;
52 0           my $cbuilder = ExtUtils::CBuilder->new( quiet => 1 );
53 0 0         $cbuilder->have_cplusplus or do {
54 0           warn "This environment does not have a C++ compiler(OS unsupported)\n";
55 0           exit 0;
56             };
57 0 0         if ( $self->_is_gcc ) {
58 0           $self->_add_extra_compiler_flags('-xc++');
59 0           $self->_add_extra_linker_flags('-lstdc++');
60             $self->_add_extra_compiler_flags('-D_FILE_OFFSET_BITS=64')
61 0 0         if $Config::Config{ccflags} =~ /-D_FILE_OFFSET_BITS=64/;
62             $self->_add_extra_linker_flags('-lgcc_s')
63 0 0 0       if $^O eq 'netbsd' && !grep {/\-lgcc_s/} @{ $self->extra_linker_flags };
  0            
  0            
64 0 0 0       if ( $args{needs_compiler_cpp} == 11 && $self->_enable_cpp11 ) {
65              
66             # Use C++11
67 0           $self->_add_extra_compiler_flags('-std=c++11');
68 0 0         if ( $self->_is_clang ) {
69 0           $self->_add_extra_compiler_flags('-stdlib=libc++');
70             }
71             }
72             }
73 0 0         if ( $self->_is_msvc ) {
74 0           $self->_add_extra_compiler_flags('-TP -EHsc');
75 0           $self->_add_extra_linker_flags('msvcprt.lib');
76             }
77             }
78              
79             # c99 is required
80 0 0         if ( $args{needs_compiler_c99} ) {
81 0           require Devel::CheckCompiler;
82 0           Devel::CheckCompiler::check_c99_or_exit();
83              
84 0 0         if ( _is_gcc() ) {
85 0           my $gccversion = _gcc_version();
86 0 0         if ( $gccversion < 5 ) {
87 0           $self->_add_extra_compiler_flags('-std=c99');
88             }
89             }
90             }
91              
92 0 0         if ( $args{cc_warnings} ) {
93 0           $self->_add_extra_compiler_flags( $self->_cc_warnings( \%args ) );
94             }
95              
96             # xshelper.h
97 0 0         if ( my $xshelper = $args{generate_xshelper_h} ) {
98 0 0         if ( $xshelper eq '1' ) { # { xshelper => 1 }
99 0           $xshelper = 'xshelper.h';
100             }
101 0           $self->xshelper_h_path($xshelper);
102 0           $self->add_to_cleanup($xshelper);
103              
104             # generate ppport.h to same directory automatically.
105 0 0         unless ( defined $args{generate_ppport_h} ) {
106 0           ( my $ppport = $xshelper ) =~ s!xshelper\.h$!ppport\.h!;
107 0           $args{generate_ppport_h} = $ppport;
108             }
109             }
110              
111             # ppport.h
112 0 0         if ( my $ppport = $args{generate_ppport_h} ) {
113 0 0         if ( $ppport eq '1' ) {
114 0           $ppport = 'ppport.h';
115             }
116 0           $self->ppport_h_path($ppport);
117 0           $self->add_to_cleanup($ppport);
118             }
119              
120 0           return $self;
121             }
122              
123             sub ACTION_code {
124 0     0 0   my $self = shift;
125              
126             # write xshelper.h
127 0 0         if ( my $xshelper = $self->xshelper_h_path ) {
128 0           File::Path::mkpath( File::Basename::dirname($xshelper) );
129              
130 0 0         if ( open( my $fh, '>', $xshelper ) ) {
131 0           print $fh _xshelper_h();
132 0           close $fh;
133             }
134             }
135              
136             # write ppport.h
137 0 0         if ( my $ppport = $self->ppport_h_path ) {
138 0           File::Path::mkpath( File::Basename::dirname($ppport) );
139 0           require Devel::PPPort;
140 0           Devel::PPPort::WriteFile($ppport);
141             }
142 0           $self->SUPER::ACTION_code(@_);
143             }
144              
145             sub ACTION_manifest_skip {
146 0     0 0   my $self = shift;
147 0           $self->SUPER::ACTION_manifest_skip(@_);
148 0 0         if ( -e 'MANIFEST.SKIP' ) {
149 0 0         open( my $fh, '<', 'MANIFEST.SKIP' ) or die $!;
150 0           my $content = do { local $/; <$fh> };
  0            
  0            
151 0           close $fh;
152 0           my $ppport = $self->ppport_h_path;
153 0 0 0       if ( $ppport && $content !~ /\Q${ppport}\E/ ) {
154              
155 0           my $safe = quotemeta($ppport);
156 0           $self->_append_maniskip("^$safe\$");
157             }
158              
159 0           my $xshelper = $self->xshelper_h_path;
160 0 0 0       if ( $xshelper && $content !~ /\Q${xshelper}\E/ ) {
161 0           my $safe = quotemeta($xshelper);
162 0           $self->_append_maniskip("^$safe\$");
163             }
164             }
165             }
166              
167             sub auto_require {
168 0     0 0   my ($self) = @_;
169 0           my $p = $self->{properties};
170 0 0 0       if ( $self->dist_name ne 'Module-Build-XSUtil'
171             and $self->auto_configure_requires )
172             {
173 0 0         if ( not exists $p->{configure_requires}{'Module::Build::XSUtil'} ) {
174 0           ( my $ver = $VERSION ) =~ s/^(\d+\.\d\d).*$/$1/; # last major release only
175 0           $self->_add_prereq( 'configure_requires', 'Module::Build::XSUtil', $ver );
176             }
177             }
178              
179 0           $self->SUPER::auto_require();
180              
181 0           return;
182             }
183              
184             sub _xs_debugging {
185 0     0     my ($self) = @_;
186 0   0       return $ENV{XS_DEBUG} || $self->args('g');
187             }
188              
189             sub _is_gcc {
190 0     0     return $Config{gccversion};
191             }
192              
193             # Microsoft Visual C++ Compiler (cl.exe)
194             sub _is_msvc {
195 0     0     return $Config{cc} =~ /\A cl \b /xmsi;
196             }
197              
198             sub _enable_cpp11 {
199 0 0   0     if ( _is_clang() ) {
    0          
200 0           my $ver = _llvm_version();
201 0           warn $ver->{major};
202 0   0       return ( $ver->{major} >= 3 && $ver->{minor} >= 2 );
203             }
204             elsif ( _is_gcc() ) {
205 0           my $ver = _gcc_version();
206 0           my ( $major, $minor ) = $ver =~ /([0-9]+\.([0-9]+))/;
207 0   0       return ( $major >= 4 && $minor >= 7 );
208             }
209             }
210              
211             sub _is_clang {
212 0     0     my $ver = `$Config{cc} --version`;
213 0 0         return $ver =~ /clang\-[0-9]+/ ? 1 : 0;
214             }
215              
216             sub _llvm_version {
217 0     0     my $ver = `$Config{cc} --version`;
218 0 0         return unless _is_clang();
219 0           my ( $llvm_majar, $llvm_minor ) = $ver =~ /LLVM\s+([0-9]+)\.([0-9]+)/;
220 0           return { major => $llvm_majar, minor => $llvm_minor };
221             }
222              
223             sub _gcc_version {
224 0     0     my $res = `$Config{cc} --version`;
225 0           my ($version) = $res =~ /(?:\(GCC\)|g?cc \([^)]+\)) ([0-9.]+)/;
226 1     1   18 no warnings 'numeric', 'uninitialized';
  1         4  
  1         492  
227 0           return sprintf '%g', $version;
228             }
229              
230             sub _cc_warnings {
231 0     0     my ( $self, $args ) = @_;
232              
233 0           my @flags;
234 0 0         if ( $self->_is_gcc() ) {
    0          
235 0           push @flags, qw(-Wall);
236              
237 0           my $gccversion = $self->_gcc_version();
238 0 0         if ( $gccversion >= 4.0 ) {
239 0           push @flags, qw(-Wextra);
240 0 0 0       if ( !( $args->{needs_compiler_c99} or $args->{needs_compiler_cpp} ) ) {
241              
242             # Note: MSVC++ doesn't support C99,
243             # so -Wdeclaration-after-statement helps
244             # ensure C89 specs.
245 0           push @flags, qw(-Wdeclaration-after-statement);
246             }
247 0 0 0       if ( $gccversion >= 4.1 && !$args->{needs_compiler_cpp} ) {
248 0           push @flags, qw(-Wc++-compat);
249             }
250             }
251             else {
252 0           push @flags, qw(-W -Wno-comment);
253             }
254             }
255             elsif ( $self->_is_msvc() ) {
256 0           push @flags, qw(-W3);
257             }
258             else {
259              
260             # TODO: support other compilers
261             }
262              
263 0           return @flags;
264             }
265              
266             sub _add_extra_compiler_flags {
267 0     0     my ( $self, @flags ) = @_;
268 0           $self->extra_compiler_flags( @{ $self->extra_compiler_flags }, @flags );
  0            
269             }
270              
271             sub _add_extra_linker_flags {
272 0     0     my ( $self, @flags ) = @_;
273 0           $self->extra_linker_flags( @{ $self->extra_linker_flags }, @flags );
  0            
274             }
275              
276             sub _xshelper_h {
277 0     0     my $h = <<'XSHELPER_H';
278             :/* THIS FILE IS AUTOMATICALLY GENERATED BY Module::Build::XSUtil $VERSION. */
279             :/*
280             :=head1 NAME
281             :
282             :xshelper.h - Helper C header file for XS modules
283             :
284             :=head1 DESCRIPTION
285             :
286             : // This includes all the perl header files and ppport.h
287             : #include "xshelper.h"
288             :
289             :=head1 SEE ALSO
290             :
291             :L, where this file is distributed as a part of
292             :
293             :=head1 AUTHOR
294             :
295             :Fuji, Goro (gfx) Egfuji at cpan.orgE
296             :
297             :=head1 LISENCE
298             :
299             :Copyright (c) 2010, Fuji, Goro (gfx). All rights reserved.
300             :
301             :This library is free software; you can redistribute it and/or modify
302             :it under the same terms as Perl itself.
303             :
304             :=cut
305             :*/
306             :
307             :#ifdef __cplusplus
308             :extern "C" {
309             :#endif
310             :
311             :#define PERL_NO_GET_CONTEXT /* we want efficiency */
312             :#include
313             :#include
314             :#define NO_XSLOCKS /* for exceptions */
315             :#include
316             :
317             :#ifdef __cplusplus
318             :} /* extern "C" */
319             :#endif
320             :
321             :#include "ppport.h"
322             :
323             :/* portability stuff not supported by ppport.h yet */
324             :
325             :#ifndef STATIC_INLINE /* from 5.13.4 */
326             :# if defined(__cplusplus) || (defined(__STDC_VERSION__) && (__STDC_VERSION__ >= 199901L))
327             :# define STATIC_INLINE static inline
328             :# else
329             :# define STATIC_INLINE static
330             :# endif
331             :#endif /* STATIC_INLINE */
332             :
333             :#ifndef __attribute__format__
334             :#define __attribute__format__(a,b,c) /* nothing */
335             :#endif
336             :
337             :#ifndef LIKELY /* they are just a compiler's hint */
338             :#define LIKELY(x) (!!(x))
339             :#define UNLIKELY(x) (!!(x))
340             :#endif
341             :
342             :#ifndef newSVpvs_share
343             :#define newSVpvs_share(s) Perl_newSVpvn_share(aTHX_ STR_WITH_LEN(s), 0U)
344             :#endif
345             :
346             :#ifndef get_cvs
347             :#define get_cvs(name, flags) get_cv(name, flags)
348             :#endif
349             :
350             :#ifndef GvNAME_get
351             :#define GvNAME_get GvNAME
352             :#endif
353             :#ifndef GvNAMELEN_get
354             :#define GvNAMELEN_get GvNAMELEN
355             :#endif
356             :
357             :#ifndef CvGV_set
358             :#define CvGV_set(cv, gv) (CvGV(cv) = (gv))
359             :#endif
360             :
361             :/* general utility */
362             :
363             :#if PERL_BCDVERSION >= 0x5008005
364             :#define LooksLikeNumber(x) looks_like_number(x)
365             :#else
366             :#define LooksLikeNumber(x) (SvPOKp(x) ? looks_like_number(x) : (I32)SvNIOKp(x))
367             :#endif
368             :
369             :#define newAV_mortal() (AV*)sv_2mortal((SV*)newAV())
370             :#define newHV_mortal() (HV*)sv_2mortal((SV*)newHV())
371             :#define newRV_inc_mortal(sv) sv_2mortal(newRV_inc(sv))
372             :#define newRV_noinc_mortal(sv) sv_2mortal(newRV_noinc(sv))
373             :
374             :#define DECL_BOOT(name) EXTERN_C XS(CAT2(boot_, name))
375             :#define CALL_BOOT(name) STMT_START { \
376             : PUSHMARK(SP); \
377             : CALL_FPTR(CAT2(boot_, name))(aTHX_ cv); \
378             : } STMT_END
379             XSHELPER_H
380 0           $h =~ s/^://xmsg;
381 0           $h =~ s/\$VERSION\b/$VERSION/xms;
382 0           return $h;
383             }
384              
385             1;
386             __END__