Commit | Line | Data |
23db00ab |
1 | package ExtUtils::HasCompiler; |
2 | $ExtUtils::HasCompiler::VERSION = '0.021'; |
3 | use strict; |
4 | use warnings; |
5 | |
6 | use base 'Exporter'; |
7 | our @EXPORT_OK = qw/can_compile_loadable_object can_compile_static_library can_compile_extension/; |
8 | our %EXPORT_TAGS = (all => \@EXPORT_OK); |
9 | |
10 | use Config; |
11 | use Carp 'carp'; |
12 | use File::Basename 'basename'; |
13 | use File::Spec::Functions qw/catfile catdir rel2abs/; |
14 | use File::Temp qw/tempdir tempfile/; |
15 | |
16 | my $tempdir = tempdir('HASCOMPILERXXXX', CLEANUP => 1, DIR => '.'); |
17 | |
18 | my $loadable_object_format = <<'END'; |
19 | #define PERL_NO_GET_CONTEXT |
20 | #include "EXTERN.h" |
21 | #include "perl.h" |
22 | #include "XSUB.h" |
23 | |
24 | #ifndef PERL_UNUSED_VAR |
25 | #define PERL_UNUSED_VAR(var) |
26 | #endif |
27 | |
28 | XS(exported) { |
29 | #ifdef dVAR |
30 | dVAR; |
31 | #endif |
32 | dXSARGS; |
33 | |
34 | PERL_UNUSED_VAR(cv); /* -W */ |
35 | PERL_UNUSED_VAR(items); /* -W */ |
36 | |
37 | XSRETURN_IV(42); |
38 | } |
39 | |
40 | #ifndef XS_EXTERNAL |
41 | #define XS_EXTERNAL(foo) XS(foo) |
42 | #endif |
43 | |
44 | /* we don't want to mess with .def files on mingw */ |
45 | #if defined(WIN32) && defined(__GNUC__) |
46 | # define EXPORT __declspec(dllexport) |
47 | #else |
48 | # define EXPORT |
49 | #endif |
50 | |
51 | EXPORT XS_EXTERNAL(boot_%s) { |
52 | #ifdef dVAR |
53 | dVAR; |
54 | #endif |
55 | dXSARGS; |
56 | |
57 | PERL_UNUSED_VAR(cv); /* -W */ |
58 | PERL_UNUSED_VAR(items); /* -W */ |
59 | |
60 | newXS("%s::exported", exported, __FILE__); |
61 | } |
62 | |
63 | END |
64 | |
65 | my $counter = 1; |
66 | my %prelinking = map { $_ => 1 } qw/MSWin32 VMS aix/; |
67 | |
68 | sub can_compile_loadable_object { |
69 | my %args = @_; |
70 | |
71 | my $output = $args{output} || \*STDOUT; |
72 | |
73 | my $config = $args{config} || 'ExtUtils::HasCompiler::Config'; |
74 | return if not $config->get('usedl'); |
75 | |
76 | my ($source_handle, $source_name) = tempfile('TESTXXXX', DIR => $tempdir, SUFFIX => '.c', UNLINK => 1); |
77 | my $basename = basename($source_name, '.c'); |
78 | my $abs_basename = catfile($tempdir, $basename); |
79 | |
80 | my ($cc, $ccflags, $optimize, $cccdlflags, $ld, $ldflags, $lddlflags, $libperl, $perllibs, $archlibexp, $_o, $dlext) = map { $config->get($_) } qw/cc ccflags optimize cccdlflags ld ldflags lddlflags libperl perllibs archlibexp _o dlext/; |
81 | |
82 | my $incdir = catdir($archlibexp, 'CORE'); |
83 | my $object_file = $abs_basename.$_o; |
84 | my $loadable_object = "$abs_basename.$dlext"; |
85 | |
86 | my @commands; |
87 | if ($^O eq 'MSWin32' && $cc =~ /^cl/) { |
88 | push @commands, qq{$cc $ccflags $cccdlflags $optimize /I "$incdir" /c $source_name /Fo$object_file}; |
89 | push @commands, qq{$ld $object_file $lddlflags $libperl $perllibs /out:$loadable_object /def:$abs_basename.def /pdb:$abs_basename.pdb}; |
90 | } |
91 | elsif ($^O eq 'VMS') { |
92 | # Mksymlists is only the beginning of the story. |
93 | open my $opt_fh, '>>', "$abs_basename.opt" or do { carp "Couldn't append to '$abs_basename.opt'"; return }; |
94 | print $opt_fh "PerlShr/Share\n"; |
95 | close $opt_fh; |
96 | |
97 | my $incdirs = $ccflags =~ s{ /inc[^=]+ (?:=)+ (?:\()? ( [^\/\)]* ) }{}xi ? "$1,$incdir" : $incdir; |
98 | push @commands, qq{$cc $ccflags $optimize /include=($incdirs) $cccdlflags $source_name /obj=$object_file}; |
99 | push @commands, qq{$ld $ldflags $lddlflags=$loadable_object $object_file,$abs_basename.opt/OPTIONS,${incdir}perlshr_attr.opt/OPTIONS' $perllibs}; |
100 | } |
101 | else { |
102 | my @extra; |
103 | if ($^O eq 'MSWin32') { |
104 | my $lib = '-l' . ($libperl =~ /lib([^.]+)\./)[0]; |
105 | push @extra, "$abs_basename.def", $lib, $perllibs; |
106 | } |
107 | elsif ($^O eq 'cygwin') { |
108 | push @extra, catfile($incdir, $config->get('useshrplib') ? 'libperl.dll.a' : 'libperl.a'); |
109 | } |
110 | elsif ($^O eq 'aix') { |
111 | $lddlflags =~ s/\Q$(BASEEXT)\E/$abs_basename/; |
112 | $lddlflags =~ s/\Q$(PERL_INC)\E/$incdir/; |
113 | } |
114 | elsif ($^O eq 'android') { |
115 | push @extra, qq{"-L$incdir"}, '-lperl', $perllibs; |
116 | } |
117 | push @commands, qq{$cc $ccflags $optimize "-I$incdir" $cccdlflags -c $source_name -o $object_file}; |
118 | push @commands, qq{$ld $object_file -o $loadable_object $lddlflags @extra}; |
119 | } |
120 | |
121 | if ($prelinking{$^O}) { |
122 | require ExtUtils::Mksymlists; |
123 | ExtUtils::Mksymlists::Mksymlists(NAME => $basename, FILE => $abs_basename, IMPORTS => {}); |
124 | } |
125 | |
126 | my $shortname = '_Loadable' . $counter++; |
127 | my $package = "ExtUtils::HasCompiler::$shortname"; |
128 | printf $source_handle $loadable_object_format, $basename, $package or do { carp "Couldn't write to $source_name: $!"; return }; |
129 | close $source_handle or do { carp "Couldn't close $source_name: $!"; return }; |
130 | |
131 | for my $command (@commands) { |
132 | print $output "$command\n" if not $args{quiet}; |
133 | system $command and do { carp "Couldn't execute $command: $!"; return }; |
134 | } |
135 | |
136 | # Skip loading when cross-compiling |
137 | return 1 if exists $args{skip_load} ? $args{skip_load} : $config->get('usecrosscompile'); |
138 | |
139 | require DynaLoader; |
140 | local @DynaLoader::dl_require_symbols = "boot_$basename"; |
141 | my $handle = DynaLoader::dl_load_file(rel2abs($loadable_object), 0); |
142 | if ($handle) { |
143 | my $symbol = DynaLoader::dl_find_symbol($handle, "boot_$basename") or do { carp "Couldn't find boot symbol for $basename"; return }; |
144 | my $compilet = DynaLoader::dl_install_xsub('__ANON__::__ANON__', $symbol, $source_name); |
145 | my $ret = eval { $compilet->(); $package->exported } or carp $@; |
146 | delete $ExtUtils::HasCompiler::{"$shortname\::"}; |
147 | eval { DynaLoader::dl_unload_file($handle) } or carp $@; |
148 | return defined $ret && $ret == 42; |
149 | } |
150 | else { |
151 | carp "Couldn't load $loadable_object: " . DynaLoader::dl_error(); |
152 | return; |
153 | } |
154 | } |
155 | |
156 | my %static_unsupported_on = map { $_ => 1 } qw/VMS aix MSWin32 cygwin/; |
157 | sub can_compile_static_library { |
158 | my %args = @_; |
159 | |
160 | my $output = $args{output} || \*STDOUT; |
161 | |
162 | my $config = $args{config} || 'ExtUtils::HasCompiler::Config'; |
163 | return if $config->get('useshrplib') eq 'true'; |
164 | |
165 | my ($source_handle, $source_name) = tempfile('TESTXXXX', DIR => $tempdir, SUFFIX => '.c', UNLINK => 1); |
166 | my $basename = basename($source_name, '.c'); |
167 | my $abs_basename = catfile($tempdir, $basename); |
168 | |
169 | my ($cc, $ccflags, $optimize, $ar, $full_ar, $ranlib, $archlibexp, $_o, $lib_ext) = map { $config->get($_) } qw/cc ccflags optimize ar full_ar ranlib archlibexp _o lib_ext/; |
170 | my $incdir = catdir($archlibexp, 'CORE'); |
171 | my $object_file = "$abs_basename$_o"; |
172 | my $static_library = $abs_basename.$lib_ext; |
173 | |
174 | my @commands; |
175 | if ($static_unsupported_on{$^O}) { |
176 | return; |
177 | } |
178 | else { |
179 | my $my_ar = length $full_ar ? $full_ar : $ar; |
180 | push @commands, qq{$cc $ccflags $optimize "-I$incdir" -c $source_name -o $object_file}; |
181 | push @commands, qq{$my_ar cr $static_library $object_file}; |
182 | push @commands, qq{$ranlib $static_library} if $ranlib ne ':'; |
183 | } |
184 | |
185 | my $shortname = '_Loadable' . $counter++; |
186 | my $package = "ExtUtils::HasCompiler::$shortname"; |
187 | printf $source_handle $loadable_object_format, $basename, $package or do { carp "Couldn't write to $source_name: $!"; return }; |
188 | close $source_handle or do { carp "Couldn't close $source_name: $!"; return }; |
189 | |
190 | for my $command (@commands) { |
191 | print $output "$command\n" if not $args{quiet}; |
192 | system $command and do { carp "Couldn't execute $command: $!"; return }; |
193 | } |
194 | return 1; |
195 | } |
196 | |
197 | sub can_compile_extension { |
198 | my %args = @_; |
199 | $args{config} ||= 'ExtUtils::HasCompiler::Config'; |
200 | my $linktype = $args{linktype} || ($args{config}->get('usedl') ? 'dynamic' : 'static'); |
201 | return $linktype eq 'static' ? can_compile_static_library(%args) : can_compile_loadable_object(%args); |
202 | } |
203 | |
204 | sub ExtUtils::HasCompiler::Config::get { |
205 | my (undef, $key) = @_; |
206 | return $ENV{uc $key} || $Config{$key}; |
207 | } |
208 | |
209 | 1; |
210 | |
211 | # ABSTRACT: Check for the presence of a compiler |
212 | |
213 | __END__ |
214 | |
215 | =pod |
216 | |
217 | =encoding UTF-8 |
218 | |
219 | =head1 NAME |
220 | |
221 | ExtUtils::HasCompiler - Check for the presence of a compiler |
222 | |
223 | =head1 VERSION |
224 | |
225 | version 0.021 |
226 | |
227 | =head1 SYNOPSIS |
228 | |
229 | use ExtUtils::HasCompiler 'can_compile_extension'; |
230 | if (can_compile_extension()) { |
231 | ... |
232 | } |
233 | else { |
234 | ... |
235 | } |
236 | |
237 | =head1 DESCRIPTION |
238 | |
239 | This module tries to check if the current system is capable of compiling, linking and loading an XS module. |
240 | |
241 | B<Notice>: this is an early release, interface stability isn't guaranteed yet. |
242 | |
243 | =head1 FUNCTIONS |
244 | |
245 | =head2 can_compile_loadable_object(%opts) |
246 | |
247 | This checks if the system can compile, link and load a perl loadable object. It may take the following options: |
248 | |
249 | =over 4 |
250 | |
251 | =item * quiet |
252 | |
253 | Do not output the executed compilation commands. |
254 | |
255 | =item * config |
256 | |
257 | An L<ExtUtils::Config|ExtUtils::Config> (compatible) object for configuration. |
258 | |
259 | =item * skip_load |
260 | |
261 | This causes can_compile_loadable_object to not try to load the generated object. This defaults to true on a cross-compiling perl. |
262 | |
263 | =back |
264 | |
265 | =head2 can_compile_static_library(%opts) |
266 | |
267 | This checks if the system can compile and link a perl static library. It does not check it it can compile a new perl with it. It may take the following options: |
268 | |
269 | =over 4 |
270 | |
271 | =item * quiet |
272 | |
273 | Do not output the executed compilation commands. |
274 | |
275 | =item * config |
276 | |
277 | An L<ExtUtils::Config|ExtUtils::Config> (compatible) object for configuration. |
278 | |
279 | =back |
280 | |
281 | =head2 can_compile_extension(%opts) |
282 | |
283 | This will call either C<can_compile_loadable_object>, or C<can_compile_static_library>, depending on which is the default on your configuration. In addition to the arguments listed above, it can take one more optional argument: |
284 | |
285 | =over 4 |
286 | |
287 | =item * linktype |
288 | |
289 | This will force the linktype to be either static or dynamic. Dynamic compilation on a static perl won't work, but static libraries can be viable on a dynamic perl. |
290 | |
291 | =back |
292 | |
293 | =head1 AUTHOR |
294 | |
295 | Leon Timmermans <leont@cpan.org> |
296 | |
297 | =head1 COPYRIGHT AND LICENSE |
298 | |
299 | This software is copyright (c) 2014 by Leon Timmermans. |
300 | |
301 | This is free software; you can redistribute it and/or modify it under |
302 | the same terms as the Perl 5 programming language system itself. |
303 | |
304 | =cut |