This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Apply changes for CPAN-Meta-YAML v0.014.
[perl5.git] / dist / ExtUtils-CBuilder / lib / ExtUtils / CBuilder / Platform / VMS.pm
CommitLineData
6b09c160 1package ExtUtils::CBuilder::Platform::VMS;
75e05f0a 2$ExtUtils::CBuilder::Platform::VMS::VERSION = '0.280221';
6b09c160
YST
3use strict;
4use ExtUtils::CBuilder::Base;
5
74d5bfab 6use vars qw(@ISA);
6b09c160
YST
7@ISA = qw(ExtUtils::CBuilder::Base);
8
cdccec0e 9use File::Spec::Functions qw(catfile catdir);
a24b8975 10use Config;
cdccec0e
CB
11
12# We do prelink, but don't want the parent to redo it.
13
4629f7b1 14sub need_prelink { 0 }
6b09c160 15
ea2e6518
RGS
16sub arg_defines {
17 my ($self, %args) = @_;
18
19 s/"/""/g foreach values %args;
20
a314697d 21 my @config_defines;
ea2e6518
RGS
22
23 # VMS can only have one define qualifier; add the one from config, if any.
a314697d
RS
24 if ($self->{config}{ccflags} =~ s{/ def[^=]+ =+ \(? ([^\/\)]*) } {}ix) {
25 push @config_defines, $1;
ea2e6518
RGS
26 }
27
a314697d 28 return '' unless keys(%args) || @config_defines;
ea2e6518
RGS
29
30 return ('/define=('
ea2e6518 31 . join(',',
a314697d 32 @config_defines,
ea2e6518
RGS
33 map "\"$_" . ( length($args{$_}) ? "=$args{$_}" : '') . "\"",
34 keys %args)
35 . ')');
36}
37
6b09c160 38sub arg_include_dirs {
2bd31f1a
SP
39 my ($self, @dirs) = @_;
40
41 # VMS can only have one include list, add the one from config.
42 if ($self->{config}{ccflags} =~ s{/inc[^=]+(?:=)+(?:\()?([^\/\)]*)} {}i) {
43 unshift @dirs, $1;
44 }
45 return unless @dirs;
46
47 return ('/include=(' . join(',', @dirs) . ')');
48}
49
a24b8975
CB
50# We override the compile method because we consume the includes and defines
51# parts of ccflags in the process of compiling but don't save those parts
52# anywhere, so $self->{config}{ccflags} needs to be reset for each compile
53# operation.
54
55sub compile {
56 my ($self, %args) = @_;
57
58 $self->{config}{ccflags} = $Config{ccflags};
59 $self->{config}{ccflags} = $ENV{CFLAGS} if defined $ENV{CFLAGS};
60
61 return $self->SUPER::compile(%args);
62}
63
2bd31f1a
SP
64sub _do_link {
65 my ($self, $type, %args) = @_;
66
67 my $objects = delete $args{objects};
68 $objects = [$objects] unless ref $objects;
69
2bd31f1a 70 if ($args{lddl}) {
2bd31f1a 71
cdccec0e
CB
72 # prelink will call Mksymlists, which creates the extension-specific
73 # linker options file and populates it with the boot symbol.
74
75 my @temp_files = $self->prelink(%args, dl_name => $args{module_name});
2bd31f1a 76
cdccec0e
CB
77 # We now add the rest of what we need to the linker options file. We
78 # should replicate the functionality of C<ExtUtils::MM_VMS::dlsyms>,
79 # but there is as yet no infrastructure for handling object libraries,
80 # so for now we depend on object files being listed individually on the
81 # command line, which should work for simple cases. We do bring in our
82 # own version of C<ExtUtils::Liblist::Kid::ext> so that any additional
83 # libraries (including PERLSHR) can be added to the options file.
84
85 my @optlibs = $self->_liblist_ext( $args{'libs'} );
86
87 my $optfile = 'sys$disk:[]' . $temp_files[0];
88 open my $opt_fh, '>>', $optfile
89 or die "_do_link: Unable to open $optfile: $!";
90 for my $lib (@optlibs) {print $opt_fh "$lib\n" if length $lib }
91 close $opt_fh;
92
93 $objects->[-1] .= ',';
94 push @$objects, $optfile . '/OPTIONS,';
2bd31f1a 95
cdccec0e
CB
96 # This one not needed for DEC C, but leave for completeness.
97 push @$objects, $self->perl_inc() . 'perlshr_attr.opt/OPTIONS';
2bd31f1a
SP
98 }
99
100 return $self->SUPER::_do_link($type, %args, objects => $objects);
6b09c160
YST
101}
102
103sub arg_nolink { return; }
104
105sub arg_object_file {
106 my ($self, $file) = @_;
107 return "/obj=$file";
108}
109
110sub arg_exec_file {
111 my ($self, $file) = @_;
112 return ("/exe=$file");
113}
114
115sub arg_share_object_file {
116 my ($self, $file) = @_;
117 return ("$self->{config}{lddlflags}=$file");
118}
119
cdccec0e
CB
120# The following is reproduced almost verbatim from ExtUtils::Liblist::Kid::_vms_ext.
121# We can't just call that because it's tied up with the MakeMaker object hierarchy.
122
123sub _liblist_ext {
124 my($self, $potential_libs,$verbose,$give_libs) = @_;
125 $verbose ||= 0;
126
127 my(@crtls,$crtlstr);
128 @crtls = ( ($self->{'config'}{'ldflags'} =~ m-/Debug-i ? $self->{'config'}{'dbgprefix'} : '')
129 . 'PerlShr/Share' );
130 push(@crtls, grep { not /\(/ } split /\s+/, $self->{'config'}{'perllibs'});
131 push(@crtls, grep { not /\(/ } split /\s+/, $self->{'config'}{'libc'});
132 # In general, we pass through the basic libraries from %Config unchanged.
133 # The one exception is that if we're building in the Perl source tree, and
134 # a library spec could be resolved via a logical name, we go to some trouble
92760223 135 # to ensure that the copy in the local tree is used, rather than one to
cdccec0e
CB
136 # which a system-wide logical may point.
137 if ($self->perl_src) {
138 my($lib,$locspec,$type);
139 foreach $lib (@crtls) {
140 if (($locspec,$type) = $lib =~ m{^([\w\$-]+)(/\w+)?} and $locspec =~ /perl/i) {
141 if (lc $type eq '/share') { $locspec .= $self->{'config'}{'exe_ext'}; }
142 elsif (lc $type eq '/library') { $locspec .= $self->{'config'}{'lib_ext'}; }
143 else { $locspec .= $self->{'config'}{'obj_ext'}; }
144 $locspec = catfile($self->perl_src, $locspec);
145 $lib = "$locspec$type" if -e $locspec;
146 }
147 }
148 }
149 $crtlstr = @crtls ? join(' ',@crtls) : '';
150
151 unless ($potential_libs) {
152 warn "Result:\n\tEXTRALIBS: \n\tLDLOADLIBS: $crtlstr\n" if $verbose;
153 return ('', '', $crtlstr, '', ($give_libs ? [] : ()));
154 }
155
156 my(@dirs,@libs,$dir,$lib,%found,@fndlibs,$ldlib);
157 my $cwd = cwd();
158 my($so,$lib_ext,$obj_ext) = @{$self->{'config'}}{'so','lib_ext','obj_ext'};
159 # List of common Unix library names and their VMS equivalents
160 # (VMS equivalent of '' indicates that the library is automatically
161 # searched by the linker, and should be skipped here.)
162 my(@flibs, %libs_seen);
163 my %libmap = ( 'm' => '', 'f77' => '', 'F77' => '', 'V77' => '', 'c' => '',
164 'malloc' => '', 'crypt' => '', 'resolv' => '', 'c_s' => '',
165 'socket' => '', 'X11' => 'DECW$XLIBSHR',
166 'Xt' => 'DECW$XTSHR', 'Xm' => 'DECW$XMLIBSHR',
167 'Xmu' => 'DECW$XMULIBSHR');
cdccec0e
CB
168
169 warn "Potential libraries are '$potential_libs'\n" if $verbose;
170
171 # First, sort out directories and library names in the input
172 foreach $lib (split ' ',$potential_libs) {
173 push(@dirs,$1), next if $lib =~ /^-L(.*)/;
174 push(@dirs,$lib), next if $lib =~ /[:>\]]$/;
175 push(@dirs,$lib), next if -d $lib;
176 push(@libs,$1), next if $lib =~ /^-l(.*)/;
177 push(@libs,$lib);
178 }
179 push(@dirs,split(' ',$self->{'config'}{'libpth'}));
180
181 # Now make sure we've got VMS-syntax absolute directory specs
182 # (We don't, however, check whether someone's hidden a relative
183 # path in a logical name.)
184 foreach $dir (@dirs) {
185 unless (-d $dir) {
186 warn "Skipping nonexistent Directory $dir\n" if $verbose > 1;
187 $dir = '';
188 next;
189 }
190 warn "Resolving directory $dir\n" if $verbose;
191 if (!File::Spec->file_name_is_absolute($dir)) {
192 $dir = catdir($cwd,$dir);
193 }
194 }
195 @dirs = grep { length($_) } @dirs;
196 unshift(@dirs,''); # Check each $lib without additions first
197
198 LIB: foreach $lib (@libs) {
199 if (exists $libmap{$lib}) {
200 next unless length $libmap{$lib};
201 $lib = $libmap{$lib};
202 }
203
204 my(@variants,$variant,$cand);
205 my($ctype) = '';
206
207 # If we don't have a file type, consider it a possibly abbreviated name and
208 # check for common variants. We try these first to grab libraries before
209 # a like-named executable image (e.g. -lperl resolves to perlshr.exe
210 # before perl.exe).
211 if ($lib !~ /\.[^:>\]]*$/) {
212 push(@variants,"${lib}shr","${lib}rtl","${lib}lib");
213 push(@variants,"lib$lib") if $lib !~ /[:>\]]/;
214 }
215 push(@variants,$lib);
216 warn "Looking for $lib\n" if $verbose;
217 foreach $variant (@variants) {
218 my($fullname, $name);
219
220 foreach $dir (@dirs) {
221 my($type);
222
223 $name = "$dir$variant";
224 warn "\tChecking $name\n" if $verbose > 2;
225 $fullname = VMS::Filespec::rmsexpand($name);
226 if (defined $fullname and -f $fullname) {
227 # It's got its own suffix, so we'll have to figure out the type
228 if ($fullname =~ /(?:$so|exe)$/i) { $type = 'SHR'; }
229 elsif ($fullname =~ /(?:$lib_ext|olb)$/i) { $type = 'OLB'; }
230 elsif ($fullname =~ /(?:$obj_ext|obj)$/i) {
231 warn "Note (probably harmless): "
232 ."Plain object file $fullname found in library list\n";
233 $type = 'OBJ';
234 }
235 else {
236 warn "Note (probably harmless): "
237 ."Unknown library type for $fullname; assuming shared\n";
238 $type = 'SHR';
239 }
240 }
241 elsif (-f ($fullname = VMS::Filespec::rmsexpand($name,$so)) or
242 -f ($fullname = VMS::Filespec::rmsexpand($name,'.exe'))) {
243 $type = 'SHR';
244 $name = $fullname unless $fullname =~ /exe;?\d*$/i;
245 }
246 elsif (not length($ctype) and # If we've got a lib already,
247 # don't bother
248 ( -f ($fullname = VMS::Filespec::rmsexpand($name,$lib_ext)) or
249 -f ($fullname = VMS::Filespec::rmsexpand($name,'.olb')))) {
250 $type = 'OLB';
251 $name = $fullname unless $fullname =~ /olb;?\d*$/i;
252 }
253 elsif (not length($ctype) and # If we've got a lib already,
254 # don't bother
255 ( -f ($fullname = VMS::Filespec::rmsexpand($name,$obj_ext)) or
256 -f ($fullname = VMS::Filespec::rmsexpand($name,'.obj')))) {
257 warn "Note (probably harmless): "
258 ."Plain object file $fullname found in library list\n";
259 $type = 'OBJ';
260 $name = $fullname unless $fullname =~ /obj;?\d*$/i;
261 }
262 if (defined $type) {
263 $ctype = $type; $cand = $name;
264 last if $ctype eq 'SHR';
265 }
266 }
267 if ($ctype) {
6f3f2a49 268 push @{$found{$ctype}}, $cand;
cdccec0e
CB
269 warn "\tFound as $cand (really $fullname), type $ctype\n"
270 if $verbose > 1;
271 push @flibs, $name unless $libs_seen{$fullname}++;
272 next LIB;
273 }
274 }
275 warn "Note (probably harmless): "
276 ."No library found for $lib\n";
277 }
278
279 push @fndlibs, @{$found{OBJ}} if exists $found{OBJ};
280 push @fndlibs, map { "$_/Library" } @{$found{OLB}} if exists $found{OLB};
281 push @fndlibs, map { "$_/Share" } @{$found{SHR}} if exists $found{SHR};
282 $lib = join(' ',@fndlibs);
283
284 $ldlib = $crtlstr ? "$lib $crtlstr" : $lib;
285 warn "Result:\n\tEXTRALIBS: $lib\n\tLDLOADLIBS: $ldlib\n" if $verbose;
286 wantarray ? ($lib, '', $ldlib, '', ($give_libs ? \@flibs : ())) : $lib;
287}
288
6b09c160 2891;