Commit | Line | Data |
38787c29 |
1 | package ExtUtils::HasCompiler; |
2 | $ExtUtils::HasCompiler::VERSION = '0.012'; |
3 | use strict; |
4 | use warnings; |
5 | |
6 | use base 'Exporter'; |
7 | our @EXPORT_OK = qw/can_compile_loadable_object/; |
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/; |
14 | use File::Temp qw/tempdir tempfile/; |
15 | |
16 | my $tempdir = tempdir(CLEANUP => 1); |
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 $config = $args{config} || 'ExtUtils::HasCompiler::Config'; |
72 | return if not $config->get('usedl'); |
73 | |
74 | my ($source_handle, $source_name) = tempfile(DIR => $tempdir, SUFFIX => '.c', UNLINK => 1); |
75 | my $basename = basename($source_name, '.c'); |
76 | |
77 | my $shortname = '_Loadable' . $counter++; |
78 | my $package = "ExtUtils::HasCompiler::$shortname"; |
79 | printf $source_handle $loadable_object_format, $basename, $package or do { carp "Couldn't write to $source_name: $!"; return }; |
80 | close $source_handle or do { carp "Couldn't close $source_name: $!"; return }; |
81 | |
82 | my $abs_basename = catfile($tempdir, $basename); |
83 | my $object_file = $abs_basename . $config->get('_o'); |
84 | my $loadable_object = $abs_basename . '.' . $config->get('dlext'); |
85 | my $incdir = catdir($config->get('archlibexp'), 'CORE'); |
86 | |
87 | my ($cc, $ccflags, $optimize, $cccdlflags, $ld, $ldflags, $lddlflags, $libperl, $perllibs) = map { $config->get($_) } qw/cc ccflags optimize cccdlflags ld ldflags lddlflags libperl perllibs/; |
88 | |
89 | if ($prelinking{$^O}) { |
90 | require ExtUtils::Mksymlists; |
91 | ExtUtils::Mksymlists::Mksymlists(NAME => $basename, FILE => $abs_basename, IMPORTS => {}); |
92 | } |
93 | my @commands; |
94 | if ($^O eq 'MSWin32' && $cc =~ /^cl/) { |
95 | push @commands, qq{$cc $ccflags $cccdlflags $optimize /I "$incdir" /c $source_name /Fo$object_file}; |
96 | push @commands, qq{$ld $object_file $lddlflags $libperl $perllibs /out:$loadable_object /def:$abs_basename.def /pdb:$abs_basename.pdb}; |
97 | } |
98 | elsif ($^O eq 'VMS') { |
99 | # Mksymlists is only the beginning of the story. |
100 | open my $opt_fh, '>>', "$abs_basename.opt" or do { carp "Couldn't append to '$abs_basename.opt'"; return }; |
101 | print $opt_fh "PerlShr/Share\n"; |
102 | close $opt_fh; |
103 | |
104 | my $incdirs = $ccflags =~ s{ /inc[^=]+ (?:=)+ (?:\()? ( [^\/\)]* ) }{}xi ? "$1,$incdir" : $incdir; |
105 | push @commands, qq{$cc $ccflags $optimize /include=($incdirs) $cccdlflags $source_name /obj=$object_file}; |
106 | push @commands, qq{$ld $ldflags $lddlflags=$loadable_object $object_file,$abs_basename.opt/OPTIONS,${incdir}perlshr_attr.opt/OPTIONS' $perllibs}; |
107 | } |
108 | else { |
109 | my @extra; |
110 | if ($^O eq 'MSWin32') { |
111 | push @extra, "$abs_basename.def"; |
112 | push @extra, '-l' . ($libperl =~ /lib([^.]+)\./)[0]; |
113 | } |
114 | elsif ($^O eq 'cygwin') { |
115 | push @extra, catfile($incdir, $config->get('useshrplib') ? 'libperl.dll.a' : 'libperl.a'); |
116 | } |
117 | elsif ($^O eq 'aix') { |
118 | $lddlflags =~ s/\Q$(BASEEXT)\E/$abs_basename/; |
119 | $lddlflags =~ s/\Q$(PERL_INC)\E/$incdir/; |
120 | } |
121 | push @commands, qq{$cc $ccflags $optimize "-I$incdir" $cccdlflags -c $source_name -o $object_file}; |
122 | push @commands, qq{$cc $optimize $object_file -o $loadable_object $lddlflags @extra $perllibs}; |
123 | } |
124 | |
125 | for my $command (@commands) { |
126 | print "$command\n" if not $args{quiet}; |
127 | system $command and do { carp "Couldn't execute $command: $!"; return }; |
128 | } |
129 | |
130 | # Skip loading when cross-compiling |
131 | return 1 if exists $args{skip_load} ? $args{skip_load} : $config->get('usecrosscompile'); |
132 | |
133 | require DynaLoader; |
134 | local @DynaLoader::dl_require_symbols = "boot_$basename"; |
135 | my $handle = DynaLoader::dl_load_file($loadable_object, 0); |
136 | if ($handle) { |
137 | my $symbol = DynaLoader::dl_find_symbol($handle, "boot_$basename") or do { carp "Couldn't find boot symbol for $basename"; return }; |
138 | my $compilet = DynaLoader::dl_install_xsub('__ANON__::__ANON__', $symbol, $source_name); |
139 | my $ret = eval { $compilet->(); $package->exported } or carp $@; |
140 | delete $ExtUtils::HasCompiler::{"$shortname\::"}; |
141 | eval { DynaLoader::dl_unload_file($handle) } or carp $@; |
142 | return defined $ret && $ret == 42; |
143 | } |
144 | else { |
145 | carp "Couldn't load $loadable_object: " . DynaLoader::dl_error(); |
146 | return; |
147 | } |
148 | } |
149 | |
150 | sub ExtUtils::HasCompiler::Config::get { |
151 | my (undef, $key) = @_; |
152 | return $ENV{uc $key} || $Config{$key}; |
153 | } |
154 | |
155 | 1; |
156 | |
157 | # ABSTRACT: Check for the presence of a compiler |
158 | |
159 | __END__ |
160 | |
161 | =pod |
162 | |
163 | =encoding UTF-8 |
164 | |
165 | =head1 NAME |
166 | |
167 | ExtUtils::HasCompiler - Check for the presence of a compiler |
168 | |
169 | =head1 VERSION |
170 | |
171 | version 0.012 |
172 | |
173 | =head1 DESCRIPTION |
174 | |
175 | This module tries to check if the current system is capable of compiling, linking and loading an XS module. |
176 | |
177 | B<Notice>: this is an early release, interface stability isn't guaranteed yet. |
178 | |
179 | =head1 FUNCTIONS |
180 | |
181 | =head2 can_compile_loadable_object(%opts) |
182 | |
183 | This checks if the system can compile, link and load a perl loadable object. It may take the following options: |
184 | |
185 | =over 4 |
186 | |
187 | =item * quiet |
188 | |
189 | Do not output the executed compilation commands. |
190 | |
191 | =item * config |
192 | |
193 | An L<ExtUtils::Config|ExtUtils::Config> (compatible) object for configuration. |
194 | |
195 | =item * skip_load |
196 | |
197 | This causes can_compile_loadable_object to not try to load the generated object. This defaults to true on a cross-compiling perl. |
198 | |
199 | =back |
200 | |
201 | =head1 AUTHOR |
202 | |
203 | Leon Timmermans <leont@cpan.org> |
204 | |
205 | =head1 COPYRIGHT AND LICENSE |
206 | |
207 | This software is copyright (c) 2014 by Leon Timmermans. |
208 | |
209 | This is free software; you can redistribute it and/or modify it under |
210 | the same terms as the Perl 5 programming language system itself. |
211 | |
212 | =cut |