diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/ExtUtils/MM_VMS.pm')
-rw-r--r-- | Master/tlpkg/tlperl/lib/ExtUtils/MM_VMS.pm | 403 |
1 files changed, 285 insertions, 118 deletions
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/MM_VMS.pm b/Master/tlpkg/tlperl/lib/ExtUtils/MM_VMS.pm index 60dd8713fc2..ed3ec8cab08 100644 --- a/Master/tlpkg/tlperl/lib/ExtUtils/MM_VMS.pm +++ b/Master/tlpkg/tlperl/lib/ExtUtils/MM_VMS.pm @@ -15,13 +15,14 @@ BEGIN { use File::Basename; -our $VERSION = '7.10_02'; +our $VERSION = '7.24'; +$VERSION = eval $VERSION; require ExtUtils::MM_Any; require ExtUtils::MM_Unix; our @ISA = qw( ExtUtils::MM_Any ExtUtils::MM_Unix ); -use ExtUtils::MakeMaker qw($Verbose neatvalue); +use ExtUtils::MakeMaker qw($Verbose neatvalue _sprintf562); our $Revision = $ExtUtils::MakeMaker::Revision; @@ -302,15 +303,22 @@ sub maybe_command { =item pasthru (override) -VMS has $(MMSQUALIFIERS) which is a listing of all the original command line -options. This is used in every invocation of make in the VMS Makefile so -PASTHRU should not be necessary. Using PASTHRU tends to blow commands past -the 256 character limit. +The list of macro definitions to be passed through must be specified using +the /MACRO qualifier and must not add another /DEFINE qualifier. We prepend +our own comma here to the contents of $(PASTHRU_DEFINE) because it is often +empty and a comma always present in CCFLAGS would generate a missing +qualifier value error. =cut sub pasthru { - return "PASTHRU=\n"; + my($self) = shift; + my $pasthru = $self->SUPER::pasthru; + $pasthru =~ s|(PASTHRU\s*=\s*)|$1/MACRO=(|; + $pasthru =~ s|\n\z|)\n|m; + $pasthru =~ s|/defi?n?e?=\(?([^\),]+)\)?|,$1|ig; + + return $pasthru; } @@ -725,13 +733,14 @@ sub cflags { my $term = $1; $term =~ s:^\((.+)\)$:$1:; push @terms, $term; - } + } if ($type eq 'Def') { push @terms, qw[ $(DEFINE_VERSION) $(XS_DEFINE_VERSION) ]; } if (@terms) { $quals =~ s:/${type}i?n?e?=[^/]+::ig; - $quals .= "/${type}ine=(" . join(',',@terms) . ')'; + # PASTHRU_DEFINE will have its own comma + $quals .= "/${type}ine=(" . join(',',@terms) . ($type eq 'Def' ? '$(PASTHRU_DEFINE)' : '') . ')'; } } @@ -884,13 +893,13 @@ sub c_o { return '' unless $self->needs_linking(); ' .c$(OBJ_EXT) : - $(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).c + $(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).c /OBJECT=$(MMS$TARGET_NAME)$(OBJ_EXT) .cpp$(OBJ_EXT) : - $(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).cpp + $(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).cpp /OBJECT=$(MMS$TARGET_NAME)$(OBJ_EXT) .cxx$(OBJ_EXT) : - $(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).cxx + $(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).cxx /OBJECT=$(MMS$TARGET_NAME)$(OBJ_EXT) '; } @@ -906,7 +915,8 @@ sub xs_c { return '' unless $self->needs_linking(); ' .xs.c : - $(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $(MMS$TARGET_NAME).xs >$(MMS$TARGET) + $(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $(MMS$TARGET_NAME).xs >$(MMS$TARGET_NAME).xsc + $(MV) $(MMS$TARGET_NAME).xsc $(MMS$TARGET_NAME).c '; } @@ -916,85 +926,211 @@ Use MM[SK] macros, and VMS command line for C compiler. =cut -sub xs_o { # many makes are too dumb to use xs_c then c_o - my($self) = @_; +sub xs_o { + my ($self) = @_; return '' unless $self->needs_linking(); - ' + my $frag = ' .xs$(OBJ_EXT) : - $(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $(MMS$TARGET_NAME).xs >$(MMS$TARGET_NAME).c - $(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).c + $(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $(MMS$TARGET_NAME).xs >$(MMS$TARGET_NAME).xsc + $(MV) $(MMS$TARGET_NAME).xsc $(MMS$TARGET_NAME).c + $(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).c /OBJECT=$(MMS$TARGET_NAME)$(OBJ_EXT) '; + if ($self->{XSMULTI}) { + for my $ext ($self->_xs_list_basenames) { + my $version = $self->parse_version("$ext.pm"); + my $ccflags = $self->{CCFLAGS}; + $ccflags =~ s/\$\(DEFINE_VERSION\)/\"VERSION_MACRO=\\"\"$version\\"\"/; + $ccflags =~ s/\$\(XS_DEFINE_VERSION\)/\"XS_VERSION_MACRO=\\"\"$version\\"\"/; + $self->_xsbuild_replace_macro($ccflags, 'xs', $ext, 'INC'); + $self->_xsbuild_replace_macro($ccflags, 'xs', $ext, 'DEFINE'); + + $frag .= _sprintf562 <<'EOF', $ext, $ccflags; + +%1$s$(OBJ_EXT) : %1$s.xs + $(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $(MMS$TARGET_NAME).xs > $(MMS$TARGET_NAME).xsc + $(MV) $(MMS$TARGET_NAME).xsc $(MMS$TARGET_NAME).c + $(CC)%2$s$(OPTIMIZE) $(CCCDLFLAGS) $(MMS$TARGET_NAME).c /OBJECT=$(MMS$TARGET_NAME)$(OBJ_EXT) +EOF + } + } + $frag; } +=item _xsbuild_replace_macro (override) -=item dlsyms (override) +There is no simple replacement possible since a qualifier and all its +subqualifiers must be considered together, so we use our own utility +routine for the replacement. -Create VMS linker options files specifying universal symbols for this -extension's shareable image, and listing other shareable images or -libraries to which it should be linked. +=cut + +sub _xsbuild_replace_macro { + my ($self, undef, $xstype, $ext, $varname) = @_; + my $value = $self->_xsbuild_value($xstype, $ext, $varname); + return unless defined $value; + $_[1] = _vms_replace_qualifier($self, $_[1], $value, $varname); +} + +=item _xsbuild_value (override) + +Convert the extension spec to Unix format, as that's what will +match what's in the XSBUILD data structure. =cut -sub dlsyms { - my($self,%attribs) = @_; +sub _xsbuild_value { + my ($self, $xstype, $ext, $varname) = @_; + $ext = unixify($ext); + return $self->SUPER::_xsbuild_value($xstype, $ext, $varname); +} - return '' unless $self->needs_linking(); +sub _vms_replace_qualifier { + my ($self, $flags, $newflag, $macro) = @_; + my $qual_type; + my $type_suffix; + my $quote_subquals = 0; + my @subquals_new = split /\s+/, $newflag; + + if ($macro eq 'DEFINE') { + $qual_type = 'Def'; + $type_suffix = 'ine'; + map { $_ =~ s/^-D// } @subquals_new; + $quote_subquals = 1; + } + elsif ($macro eq 'INC') { + $qual_type = 'Inc'; + $type_suffix = 'lude'; + map { $_ =~ s/^-I//; $_ = $self->fixpath($_) } @subquals_new; + } - my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {}; - my($vars) = $attribs{DL_VARS} || $self->{DL_VARS} || []; - my($funclist) = $attribs{FUNCLIST} || $self->{FUNCLIST} || []; - my(@m); + my @subquals = (); + while ($flags =~ m:/${qual_type}\S{0,4}=([^/]+):ig) { + my $term = $1; + $term =~ s/\"//g; + $term =~ s:^\((.+)\)$:$1:; + push @subquals, split /,/, $term; + } + for my $new (@subquals_new) { + my ($sq_new, $sqval_new) = split /=/, $new; + my $replaced_old = 0; + for my $old (@subquals) { + my ($sq, $sqval) = split /=/, $old; + if ($sq_new eq $sq) { + $old = $sq_new; + $old .= '=' . $sqval_new if defined($sqval_new) and length($sqval_new); + $replaced_old = 1; + last; + } + } + push @subquals, $new unless $replaced_old; + } - unless ($self->{SKIPHASH}{'dynamic'}) { - push(@m,' -dynamic :: $(INST_ARCHAUTODIR)$(BASEEXT).opt - $(NOECHO) $(NOOP) -'); + if (@subquals) { + $flags =~ s:/${qual_type}\S{0,4}=[^/]+::ig; + # add quotes if requested but not for unexpanded macros + map { $_ = qq/"$_"/ if $_ !~ m/^\$\(/ } @subquals if $quote_subquals; + $flags .= "/${qual_type}$type_suffix=(" . join(',',@subquals) . ')'; } - push(@m,' -static :: $(INST_ARCHAUTODIR)$(BASEEXT).opt - $(NOECHO) $(NOOP) -') unless $self->{SKIPHASH}{'static'}; + return $flags; +} - push @m,' -$(INST_ARCHAUTODIR)$(BASEEXT).opt : $(BASEEXT).opt - $(CP) $(MMS$SOURCE) $(MMS$TARGET) -$(BASEEXT).opt : Makefile.PL - $(PERLRUN) -e "use ExtUtils::Mksymlists;" - - ',qq[-e "Mksymlists('NAME' => '$self->{NAME}', 'DL_FUNCS' => ], - neatvalue($funcs),q[, 'DL_VARS' => ],neatvalue($vars), - q[, 'FUNCLIST' => ],neatvalue($funclist),qq[)"\n]; - - push @m, ' $(PERL) -e "print ""$(INST_STATIC)/Include='; - if ($self->{OBJECT} =~ /\bBASEEXT\b/ or - $self->{OBJECT} =~ /\b$self->{BASEEXT}\b/i) { - push @m, ($Config{d_vms_case_sensitive_symbols} - ? uc($self->{BASEEXT}) :'$(BASEEXT)'); - } - else { # We don't have a "main" object file, so pull 'em all in - # Upcase module names if linker is being case-sensitive - my($upcase) = $Config{d_vms_case_sensitive_symbols}; - my(@omods) = split ' ', $self->eliminate_macros($self->{OBJECT}); - for (@omods) { - s/\.[^.]*$//; # Trim off file type - s[\$\(\w+_EXT\)][]; # even as a macro - s/.*[:>\/\]]//; # Trim off dir spec - $_ = uc if $upcase; - }; - - my(@lines); - my $tmp = shift @omods; - foreach my $elt (@omods) { - $tmp .= ",$elt"; - if (length($tmp) > 80) { push @lines, $tmp; $tmp = ''; } +sub xs_dlsyms_ext { + '.opt'; +} + +=item dlsyms (override) + +Create VMS linker options files specifying universal symbols for this +extension's shareable image(s), and listing other shareable images or +libraries to which it should be linked. + +=cut + +sub dlsyms { + my ($self, %attribs) = @_; + return '' unless $self->needs_linking; + $self->xs_dlsyms_iterator; +} + +sub xs_make_dlsyms { + my ($self, $attribs, $target, $dep, $name, $dlbase, $funcs, $funclist, $imports, $vars, $extra) = @_; + my @m; + my $instloc; + if ($self->{XSMULTI}) { + my ($v, $d, $f) = File::Spec->splitpath($target); + my @d = File::Spec->splitdir($d); + shift @d if $d[0] eq 'lib'; + $instloc = $self->catfile('$(INST_ARCHLIB)', 'auto', @d, $f); + push @m,"\ndynamic :: $instloc\n\t\$(NOECHO) \$(NOOP)\n" + unless $self->{SKIPHASH}{'dynamic'}; + push @m,"\nstatic :: $instloc\n\t\$(NOECHO) \$(NOOP)\n" + unless $self->{SKIPHASH}{'static'}; + push @m, "\n", sprintf <<'EOF', $instloc, $target; +%s : %s + $(CP) $(MMS$SOURCE) $(MMS$TARGET) +EOF + } + else { + push @m,"\ndynamic :: \$(INST_ARCHAUTODIR)$self->{BASEEXT}.opt\n\t\$(NOECHO) \$(NOOP)\n" + unless $self->{SKIPHASH}{'dynamic'}; + push @m,"\nstatic :: \$(INST_ARCHAUTODIR)$self->{BASEEXT}.opt\n\t\$(NOECHO) \$(NOOP)\n" + unless $self->{SKIPHASH}{'static'}; + push @m, "\n", sprintf <<'EOF', $target; +$(INST_ARCHAUTODIR)$(BASEEXT).opt : %s + $(CP) $(MMS$SOURCE) $(MMS$TARGET) +EOF + } + push @m, + "\n$target : $dep\n\t", + q!$(PERLRUN) -MExtUtils::Mksymlists -e "Mksymlists('NAME'=>'!, $name, + q!', 'DLBASE' => '!,$dlbase, + q!', 'DL_FUNCS' => !,neatvalue($funcs), + q!, 'FUNCLIST' => !,neatvalue($funclist), + q!, 'IMPORTS' => !,neatvalue($imports), + q!, 'DL_VARS' => !, neatvalue($vars); + push @m, $extra if defined $extra; + push @m, qq!);"\n\t!; + # Can't use dlbase as it's been through mod2fname. + my $olb_base = basename($target, '.opt'); + if ($self->{XSMULTI}) { + # We've been passed everything but the kitchen sink -- and the location of the + # static library we're using to build the dynamic library -- so concoct that + # location from what we do have. + my $olb_dir = $self->catdir(dirname($instloc), $olb_base); + push @m, qq!\$(PERL) -e "print ""${olb_dir}${olb_base}\$(LIB_EXT)/Include=!; + push @m, ($Config{d_vms_case_sensitive_symbols} ? uc($olb_base) : $olb_base); + push @m, '\n' . $olb_dir . $olb_base . '$(LIB_EXT)/Library\n"";" >>$(MMS$TARGET)',"\n"; + } + else { + push @m, qq!\$(PERL) -e "print ""\$(INST_ARCHAUTODIR)${olb_base}\$(LIB_EXT)/Include=!; + if ($self->{OBJECT} =~ /\bBASEEXT\b/ or + $self->{OBJECT} =~ /\b$self->{BASEEXT}\b/i) { + push @m, ($Config{d_vms_case_sensitive_symbols} + ? uc($self->{BASEEXT}) :'$(BASEEXT)'); + } + else { # We don't have a "main" object file, so pull 'em all in + # Upcase module names if linker is being case-sensitive + my($upcase) = $Config{d_vms_case_sensitive_symbols}; + my(@omods) = split ' ', $self->eliminate_macros($self->{OBJECT}); + for (@omods) { + s/\.[^.]*$//; # Trim off file type + s[\$\(\w+_EXT\)][]; # even as a macro + s/.*[:>\/\]]//; # Trim off dir spec + $_ = uc if $upcase; + }; + my(@lines); + my $tmp = shift @omods; + foreach my $elt (@omods) { + $tmp .= ",$elt"; + if (length($tmp) > 80) { push @lines, $tmp; $tmp = ''; } + } + push @lines, $tmp; + push @m, '(', join( qq[, -\\n\\t"";" >>\$(MMS\$TARGET)\n\t\$(PERL) -e "print ""], @lines),')'; } - push @lines, $tmp; - push @m, '(', join( qq[, -\\n\\t"";" >>\$(MMS\$TARGET)\n\t\$(PERL) -e "print ""], @lines),')'; + push @m, '\n$(INST_ARCHAUTODIR)' . $olb_base . '$(LIB_EXT)/Library\n"";" >>$(MMS$TARGET)',"\n"; } - push @m, '\n$(INST_STATIC)/Library\n"";" >>$(MMS$TARGET)',"\n"; - if (length $self->{LDLOADLIBS}) { my($line) = ''; foreach my $lib (split ' ', $self->{LDLOADLIBS}) { @@ -1007,9 +1143,19 @@ $(BASEEXT).opt : Makefile.PL } push @m, "\t\$(PERL) -e \"print qq{$line}\" >>\$(MMS\$TARGET)\n" if $line; } + join '', @m; +} - join('',@m); +=item xs_obj_opt + +Override to fixup -o flags. + +=cut + +sub xs_obj_opt { + my ($self, $output_file) = @_; + "/OBJECT=$output_file"; } =item dynamic_lib (override) @@ -1018,54 +1164,58 @@ Use VMS Link command. =cut -sub dynamic_lib { - my($self, %attribs) = @_; - return '' unless $self->needs_linking(); #might be because of a subdir - - return '' unless $self->has_link_code(); +sub xs_dynamic_lib_macros { + my ($self, $attribs) = @_; + my $otherldflags = $attribs->{OTHERLDFLAGS} || ""; + my $inst_dynamic_dep = $attribs->{INST_DYNAMIC_DEP} || ""; + sprintf <<'EOF', $otherldflags, $inst_dynamic_dep; +# This section creates the dynamically loadable objects from relevant +# objects and possibly $(MYEXTLIB). +OTHERLDFLAGS = %s +INST_DYNAMIC_DEP = %s +EOF +} - my($otherldflags) = $attribs{OTHERLDFLAGS} || ""; - my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || ""; +sub xs_make_dynamic_lib { + my ($self, $attribs, $from, $to, $todir, $ldfrom, $exportlist) = @_; my $shr = $Config{'dbgprefix'} . 'PerlShr'; - my(@m); - push @m," - -OTHERLDFLAGS = $otherldflags -INST_DYNAMIC_DEP = $inst_dynamic_dep - -"; - push @m, ' -$(INST_DYNAMIC) : $(INST_STATIC) $(PERL_INC)perlshr_attr.opt $(INST_ARCHAUTODIR)$(DFSEP).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP) - If F$TrnLNm("',$shr,'").eqs."" Then Define/NoLog/User ',"$shr Sys\$Share:$shr.$Config{'dlext'}",' - Link $(LDFLAGS) /Shareable=$(MMS$TARGET)$(OTHERLDFLAGS) $(BASEEXT).opt/Option,$(PERL_INC)perlshr_attr.opt/Option -'; - - join('',@m); + $exportlist =~ s/.def$/.opt/; # it's a linker options file + # 1 2 3 4 5 + _sprintf562 <<'EOF', $to, $todir, $exportlist, $shr, "$shr Sys\$Share:$shr.$Config{'dlext'}"; +%1$s : $(INST_STATIC) $(PERL_INC)perlshr_attr.opt %2$s$(DFSEP).exists %3$s $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP) + If F$TrnLNm("%4$s").eqs."" Then Define/NoLog/User %5$s + Link $(LDFLAGS) /Shareable=$(MMS$TARGET)$(OTHERLDFLAGS) %3$s/Option,$(PERL_INC)perlshr_attr.opt/Option +EOF } - -=item static_lib (override) +=item xs_make_static_lib (override) Use VMS commands to manipulate object library. =cut -sub static_lib { - my($self) = @_; - return '' unless $self->needs_linking(); - - return ' -$(INST_STATIC) : - $(NOECHO) $(NOOP) -' unless ($self->{OBJECT} or @{$self->{C} || []} or $self->{MYEXTLIB}); +sub xs_make_static_lib { + my ($self, $object, $to, $todir) = @_; + + my @objects; + if ($self->{XSMULTI}) { + # The extension name should be the main object file name minus file type. + my $lib = $object; + $lib =~ s/\$\(OBJ_EXT\)\z//; + my $override = $self->_xsbuild_value('xs', $lib, 'OBJECT'); + $object = $override if defined $override; + @objects = map { $self->fixpath($_,0) } split /(?<!\^)\s+/, $object; + } + else { + push @objects, $object; + } - my(@m); - push @m,' -# Rely on suffix rule for update action -$(OBJECT) : $(INST_ARCHAUTODIR)$(DFSEP).exists + my @m; + for my $obj (@objects) { + push(@m, sprintf "\n%s : %s\$(DFSEP).exists", $obj, $todir); + } + push(@m, sprintf "\n\n%s : %s \$(MYEXTLIB)\n", $to, (join ' ', @objects)); -$(INST_STATIC) : $(OBJECT) $(MYEXTLIB) -'; # If this extension has its own library (eg SDBM_File) # then copy that to $(INST_STATIC) and add $(OBJECT) into it. push(@m, "\t",'$(CP) $(MYEXTLIB) $(MMS$TARGET)',"\n") if $self->{MYEXTLIB}; @@ -1076,8 +1226,11 @@ $(INST_STATIC) : $(OBJECT) $(MYEXTLIB) # 'cause it's a library and you can't stick them in other libraries. # In that case, we use $OBJECT instead and hope for the best if ($self->{MYEXTLIB}) { - push(@m,"\t",'Library/Object/Replace $(MMS$TARGET) $(OBJECT)',"\n"); - } else { + for my $obj (@objects) { + push(@m,"\t",'Library/Object/Replace $(MMS$TARGET) ' . $obj,"\n"); + } + } + else { push(@m,"\t",'Library/Object/Replace $(MMS$TARGET) $(MMS$SOURCE_LIST)',"\n"); } @@ -1359,7 +1512,7 @@ $(PERL_ARCHLIB)Config.pm : $(PERL_SRC)config.sh ]); } - push(@m, join(" ", map($self->fixpath($_,0),values %{$self->{XS}}))." : \$(XSUBPPDEPS)\n") + push(@m, join(" ", map($self->fixpath($_,0),sort values %{$self->{XS}}))." : \$(XSUBPPDEPS)\n") if %{$self->{XS}}; join('',@m); @@ -1469,7 +1622,7 @@ $(MAP_TARGET) :: $(MAKE_APERL_FILE) # (e.g. Intuit::DWIM will precede Intuit, so unresolved # references from [.intuit.dwim]dwim.obj can be found # in [.intuit]intuit.olb). - for (sort { length($a) <=> length($b) } keys %olbs) { + for (sort { length($a) <=> length($b) || $a cmp $b } keys %olbs) { next unless $olbs{$_} =~ /\Q$self->{LIB_EXT}\E$/; my($dir) = $self->fixpath($_,1); my($extralibs) = $dir . "extralibs.ld"; @@ -1615,7 +1768,7 @@ map_clean : =item maketext_filter (override) -Insure that colons marking targets are preceded by space, in order +Ensure that colons marking targets are preceded by space, in order to distinguish the target delimiter from a colon appearing as part of a filespec. @@ -1778,7 +1931,7 @@ sub oneliner { =item B<echo> perl trips up on "<foo>" thinking it's an input redirect. So we use the -native Write command instead. Besides, its faster. +native Write command instead. Besides, it's faster. =cut @@ -1975,7 +2128,12 @@ sub eliminate_macros { $complex = 1; } } - else { ($macro = unixify($self->{$macro})) =~ s#/\Z(?!\n)##; } + else { + $macro = $self->{$macro}; + # Don't unixify if there is unescaped whitespace + $macro = unixify($macro) unless ($macro =~ /(?<!\^)\s/); + $macro =~ s#/\Z(?!\n)##; + } $npath = "$head$macro$tail"; } } @@ -2072,6 +2230,15 @@ sub is_make_type { } +=item make_type (override) + +Returns a suitable string describing the type of makefile being written. + +=cut + +sub make_type { "$Config{make}-style"; } + + =back |