| Commit | Line | Data |
|---|
| 0effd05f |
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 |
projects / p5sagit/Class-Accessor-Grouped.git / blame