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