Commit | Line | Data |
58cd9d45 |
1 | package ExtUtils::HasCompiler; |
2 | $ExtUtils::HasCompiler::VERSION = '0.014'; |
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 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 | |
79 | my $shortname = '_Loadable' . $counter++; |
80 | my $package = "ExtUtils::HasCompiler::$shortname"; |
81 | printf $source_handle $loadable_object_format, $basename, $package or do { carp "Couldn't write to $source_name: $!"; return }; |
82 | close $source_handle or do { carp "Couldn't close $source_name: $!"; return }; |
83 | |
84 | my $abs_basename = catfile($tempdir, $basename); |
85 | my $object_file = $abs_basename . $config->get('_o'); |
86 | my $loadable_object = $abs_basename . '.' . $config->get('dlext'); |
87 | my $incdir = catdir($config->get('archlibexp'), 'CORE'); |
88 | |
89 | my ($cc, $ccflags, $optimize, $cccdlflags, $ld, $ldflags, $lddlflags, $libperl, $perllibs) = map { $config->get($_) } qw/cc ccflags optimize cccdlflags ld ldflags lddlflags libperl perllibs/; |
90 | |
91 | if ($prelinking{$^O}) { |
92 | require ExtUtils::Mksymlists; |
93 | ExtUtils::Mksymlists::Mksymlists(NAME => $basename, FILE => $abs_basename, IMPORTS => {}); |
94 | } |
95 | my @commands; |
96 | if ($^O eq 'MSWin32' && $cc =~ /^cl/) { |
97 | push @commands, qq{$cc $ccflags $cccdlflags $optimize /I "$incdir" /c $source_name /Fo$object_file}; |
98 | push @commands, qq{$ld $object_file $lddlflags $libperl $perllibs /out:$loadable_object /def:$abs_basename.def /pdb:$abs_basename.pdb}; |
99 | } |
100 | elsif ($^O eq 'VMS') { |
101 | # Mksymlists is only the beginning of the story. |
102 | open my $opt_fh, '>>', "$abs_basename.opt" or do { carp "Couldn't append to '$abs_basename.opt'"; return }; |
103 | print $opt_fh "PerlShr/Share\n"; |
104 | close $opt_fh; |
105 | |
106 | my $incdirs = $ccflags =~ s{ /inc[^=]+ (?:=)+ (?:\()? ( [^\/\)]* ) }{}xi ? "$1,$incdir" : $incdir; |
107 | push @commands, qq{$cc $ccflags $optimize /include=($incdirs) $cccdlflags $source_name /obj=$object_file}; |
108 | push @commands, qq{$ld $ldflags $lddlflags=$loadable_object $object_file,$abs_basename.opt/OPTIONS,${incdir}perlshr_attr.opt/OPTIONS' $perllibs}; |
109 | } |
110 | else { |
111 | my @extra; |
112 | if ($^O eq 'MSWin32') { |
113 | my $lib = '-l' . ($libperl =~ /lib([^.]+)\./)[0]; |
114 | push @extra, "$abs_basename.def", $lib, $perllibs; |
115 | } |
116 | elsif ($^O eq 'cygwin') { |
117 | push @extra, catfile($incdir, $config->get('useshrplib') ? 'libperl.dll.a' : 'libperl.a'); |
118 | } |
119 | elsif ($^O eq 'aix') { |
120 | $lddlflags =~ s/\Q$(BASEEXT)\E/$abs_basename/; |
121 | $lddlflags =~ s/\Q$(PERL_INC)\E/$incdir/; |
122 | } |
123 | elsif ($^O eq 'android') { |
124 | push @extra, qq{"-L$incdir"}, '-lperl', $perllibs; |
125 | } |
126 | push @commands, qq{$cc $ccflags $optimize "-I$incdir" $cccdlflags -c $source_name -o $object_file}; |
127 | push @commands, qq{$cc $optimize $object_file -o $loadable_object $lddlflags @extra}; |
128 | } |
129 | |
130 | for my $command (@commands) { |
131 | print $output "$command\n" if not $args{quiet}; |
132 | system $command and do { carp "Couldn't execute $command: $!"; return }; |
133 | } |
134 | |
135 | # Skip loading when cross-compiling |
136 | return 1 if exists $args{skip_load} ? $args{skip_load} : $config->get('usecrosscompile'); |
137 | |
138 | require DynaLoader; |
139 | local @DynaLoader::dl_require_symbols = "boot_$basename"; |
140 | my $handle = DynaLoader::dl_load_file(rel2abs($loadable_object), 0); |
141 | if ($handle) { |
142 | my $symbol = DynaLoader::dl_find_symbol($handle, "boot_$basename") or do { carp "Couldn't find boot symbol for $basename"; return }; |
143 | my $compilet = DynaLoader::dl_install_xsub('__ANON__::__ANON__', $symbol, $source_name); |
144 | my $ret = eval { $compilet->(); $package->exported } or carp $@; |
145 | delete $ExtUtils::HasCompiler::{"$shortname\::"}; |
146 | eval { DynaLoader::dl_unload_file($handle) } or carp $@; |
147 | return defined $ret && $ret == 42; |
148 | } |
149 | else { |
150 | carp "Couldn't load $loadable_object: " . DynaLoader::dl_error(); |
151 | return; |
152 | } |
153 | } |
154 | |
155 | sub ExtUtils::HasCompiler::Config::get { |
156 | my (undef, $key) = @_; |
157 | return $ENV{uc $key} || $Config{$key}; |
158 | } |
159 | |
160 | 1; |