(Replaced by #4265.)
[p5sagit/p5-mst-13.2.git] / lib / ExtUtils / MM_VMS.pm
index 34a0d34..a2a949b 100644 (file)
@@ -3,7 +3,7 @@
 #   This package is inserted into @ISA of MakeMaker's MM before the
 #   built-in ExtUtils::MM_Unix methods if MakeMaker.pm is run under VMS.
 #
-#   Author:  Charles Bailey  bailey@genetics.upenn.edu
+#   Author:  Charles Bailey  bailey@newman.upenn.edu
 
 package ExtUtils::MM_VMS;
 
@@ -14,7 +14,7 @@ use VMS::Filespec;
 use File::Basename;
 
 use vars qw($Revision);
-$Revision = '5.42 (31-Mar-1997)';
+$Revision = '5.56 (27-Apr-1999)';
 
 unshift @MM::ISA, 'ExtUtils::MM_VMS';
 
@@ -52,7 +52,7 @@ sub eliminate_macros {
        print "eliminate_macros('') = ||\n" if $Verbose >= 3;
        return '';
     }
-    my($npath) = unixify($path);
+    my($npath) = join(' ', map(unixify($_), split(/\s+/, $path)));
     my($complex) = 0;
     my($head,$macro,$tail);
 
@@ -67,7 +67,7 @@ sub eliminate_macros {
                 }
                 else {
                     print "Note: can't expand macro \$($macro) containing ",ref($self->{$macro}),
-                          "\n\t(using MMK-specific deferred substitutuon; MMS will break)\n";
+                          "\n\t(using MMK-specific deferred substitution; MMS will break)\n";
                     $macro = "\cB$macro\cB";
                     $complex = 1;
                 }
@@ -107,10 +107,11 @@ sub fixpath {
 
     if ($path =~ m#^\$\([^\)]+\)$# || $path =~ m#[/:>\]]#) { 
         if ($force_path or $path =~ /(?:DIR\)|\])$/) {
-            $fixedpath = vmspath($self->eliminate_macros($path));
+            $fixedpath = join(' ', map(vmspath($_),split(/\s+/, $self->eliminate_macros($path))));
         }
         else {
-            $fixedpath = vmsify($self->eliminate_macros($path));
+            $fixedpath = join(' ', map(vmsify($_),split(/\s+/, $self->eliminate_macros($path))));
+
         }
     }
     elsif ((($prefix,$name) = ($path =~ m#^\$\(([^\)]+)\)(.+)#)) && $self->{$prefix}) {
@@ -626,10 +627,13 @@ sub constants {
     my(@m,$def,$macro);
 
     if ($self->{DEFINE} ne '') {
-       my(@defs) = split(/\s+/,$self->{DEFINE});
-       foreach $def (@defs) {
+       my(@terms) = split(/\s+/,$self->{DEFINE});
+       my(@defs,@udefs);
+       foreach $def (@terms) {
            next unless $def;
-           if ($def =~ s/^-D//) {       # If it was a Unix-style definition
+           my $targ = \@defs;
+           if ($def =~ s/^-([DU])//) {       # If it was a Unix-style definition
+               if ($1 eq 'U') { $targ = \@udefs; }
                $def =~ s/='(.*)'$/=$1/;  # then remove shell-protection ''
                $def =~ s/^'(.*)'$/$1/;   # from entire term or argument
            }
@@ -637,8 +641,11 @@ sub constants {
                $def =~ s/"/""/g;  # Protect existing " from DCL
                $def = qq["$def"]; # and quote to prevent parsing of =
            }
+           push @$targ, $def;
        }
-       $self->{DEFINE} = join ',',@defs;
+       $self->{DEFINE} = '';
+       if (@defs)  { $self->{DEFINE}  = '/Define=(' . join(',',@defs)  . ')'; }
+       if (@udefs) { $self->{DEFINE} .= '/Undef=('  . join(',',@udefs) . ')'; }
     }
 
     if ($self->{OBJECT} =~ /\s/) {
@@ -829,7 +836,7 @@ sub cflags {
            $quals =~ s/ -$type$def\s*//;
            $def =~ s/"/""/g;
            if    ($type eq 'D') { $definestr .= qq["$def",]; }
-           elsif ($type eq 'I') { $flagincstr .= ',' . $self->fixpath($def,1); }
+           elsif ($type eq 'I') { $incstr .= ',' . $self->fixpath($def,1); }
            else                 { $undefstr  .= qq["$def",]; }
        }
     }
@@ -842,37 +849,36 @@ sub cflags {
     # Deal with $self->{DEFINE} here since some C compilers pay attention
     # to only one /Define clause on command line, so we have to
     # conflate the ones from $Config{'ccflags'} and $self->{DEFINE}
-    if ($quals =~ m:(.*)/define=\(?([^\(\/\)\s]+)\)?(.*)?:i) {
-       $quals = "$1/Define=($2," . ($self->{DEFINE} ? "$self->{DEFINE}," : '') .
-                "\$(DEFINE_VERSION),\$(XS_DEFINE_VERSION))$3";
-    }
-    else {
-       $quals .= '/Define=(' . ($self->{DEFINE} ? "$self->{DEFINE}," : '') .
-                 '$(DEFINE_VERSION),$(XS_DEFINE_VERSION))';
+    # ($self->{DEFINE} has already been VMSified in constants() above)
+    if ($self->{DEFINE}) { $quals .= $self->{DEFINE}; }
+    for $type (qw(Def Undef)) {
+       my(@terms);
+       while ($quals =~ m:/${type}i?n?e?=([^/]+):ig) {
+               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) . ')';
+       }
     }
 
     $libperl or $libperl = $self->{LIBPERL_A} || "libperl.olb";
-# This whole section is commented out, since I don't think it's necessary (or applicable)
-#    if ($libperl =~ s/^$Config{'dbgprefix'}//) { $libperl =~ s/perl([^Dd]*)\./perld$1./; }
-#    if ($libperl =~ /libperl(\w+)\./i) {
-#      my($type) = uc $1;
-#      my(%map) = ( 'D'  => 'DEBUGGING', 'E' => 'EMBED', 'M' => 'MULTIPLICITY',
-#                   'DE' => 'DEBUGGING,EMBED', 'DM' => 'DEBUGGING,MULTIPLICITY',
-#                   'EM' => 'EMBED,MULTIPLICITY', 'DEM' => 'DEBUGGING,EMBED,MULTIPLICITY' );
-#      my($add) = join(',', grep { $quals !~ /\b$_\b/ } split(/,/,$map{$type}));
-#      $quals =~ s:/define=\(([^\)]+)\):/Define=($1,$add):i if $add;
-#      $self->{PERLTYPE} ||= $type;
-#    }
 
     # Likewise with $self->{INC} and /Include
     if ($self->{'INC'}) {
        my(@includes) = split(/\s+/,$self->{INC});
        foreach (@includes) {
            s/^-I//;
-           $incstr .= ', '.$self->fixpath($_,1);
+           $incstr .= ','.$self->fixpath($_,1);
        }
     }
     $quals .= "$incstr)";
+#    $quals =~ s/,,/,/g; $quals =~ s/\(,/(/g;
     $self->{CCFLAGS} = $quals;
 
     $self->{OPTIMIZE} ||= $flagoptstr || $Config{'optimize'};
@@ -1322,6 +1328,7 @@ sub dlsyms {
 
     my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {};
     my($vars)  = $attribs{DL_VARS}  || $self->{DL_VARS}  || [];
+    my($funclist)  = $attribs{FUNCLIST}  || $self->{FUNCLIST}  || [];
     my(@m);
 
     unless ($self->{SKIPHASH}{'dynamic'}) {
@@ -1343,7 +1350,8 @@ $(INST_ARCHAUTODIR)$(BASEEXT).opt : $(BASEEXT).opt
 $(BASEEXT).opt : Makefile.PL
        $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use ExtUtils::Mksymlists;" -
        ',qq[-e "Mksymlists('NAME' => '$self->{NAME}', 'DL_FUNCS' => ],
-       neatvalue($funcs),q[, 'DL_VARS' => ],neatvalue($vars),')"
+       neatvalue($funcs),q[, 'DL_VARS' => ],neatvalue($vars),
+       q[, 'FUNCLIST' => ],neatvalue($funclist),')"
        $(PERL) -e "print ""$(INST_STATIC)/Include=$(BASEEXT)\n$(INST_STATIC)/Library\n"";" >>$(MMS$TARGET)
 ');
 
@@ -1389,7 +1397,7 @@ INST_DYNAMIC_DEP = $inst_dynamic_dep
     push @m, '
 $(INST_DYNAMIC) : $(INST_STATIC) $(PERL_INC)perlshr_attr.opt $(INST_ARCHAUTODIR).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP)
        $(NOECHO) $(MKPATH) $(INST_ARCHAUTODIR)
-       $(NOECHO) If F$TrnLNm("',$shr,'").eqs."" Then Define/NoLog/User ',"$shr Sys\$Share:$shr.$Config{'dlext'}",'
+       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
 ';
 
@@ -1441,7 +1449,7 @@ $(INST_STATIC) :
        $(NOECHO) $(NOOP)
 ' unless ($self->{OBJECT} or @{$self->{C} || []} or $self->{MYEXTLIB});
 
-    my(@m);
+    my(@m,$lib);
     push @m,'
 # Rely on suffix rule for update action
 $(OBJECT) : $(INST_ARCHAUTODIR).exists
@@ -1463,7 +1471,10 @@ $(INST_STATIC) : $(OBJECT) $(MYEXTLIB)
       push(@m,"\t",'Library/Object/Replace $(MMS$TARGET) $(MMS$SOURCE_LIST)',"\n");
     }
     
-    push(@m,"\t",'$(NOECHO) $(PERL) -e "open F,\'>>$(INST_ARCHAUTODIR)extralibs.ld\';print F qq{$(EXTRALIBS)\n};close F;"',"\n");
+    push @m, "\t\$(NOECHO) \$(PERL) -e 1 >\$(INST_ARCHAUTODIR)extralibs.ld\n";
+    foreach $lib (split ' ', $self->{EXTRALIBS}) {
+      push(@m,"\t",'$(NOECHO) $(PERL) -e "print qq{',$lib,'\n}" >>$(INST_ARCHAUTODIR)extralibs.ld',"\n");
+    }
     push @m, $self->dir_target('$(INST_ARCHAUTODIR)');
     join('',@m);
 }
@@ -1530,15 +1541,20 @@ sub processPL {
     return "" unless $self->{PL_FILES};
     my(@m, $plfile);
     foreach $plfile (sort keys %{$self->{PL_FILES}}) {
-       my $vmsplfile = vmsify($plfile);
-       my $vmsfile = vmsify($self->{PL_FILES}->{$plfile});
-       push @m, "
+        my $list = ref($self->{PL_FILES}->{$plfile})
+               ? $self->{PL_FILES}->{$plfile}
+               : [$self->{PL_FILES}->{$plfile}];
+       foreach $target (@$list) {
+           my $vmsplfile = vmsify($plfile);
+           my $vmsfile = vmsify($target);
+           push @m, "
 all :: $vmsfile
        \$(NOECHO) \$(NOOP)
 
 $vmsfile :: $vmsplfile
-",'    $(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" '," $vmsplfile
+",'    $(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" '," $vmsplfile $vmsfile
 ";
+       }
     }
     join "", @m;
 }
@@ -1988,6 +2004,7 @@ $(OBJECT) : $(PERL_INC)mg.h, $(PERL_INC)op.h, $(PERL_INC)opcode.h, $(PERL_INC)pa
 $(OBJECT) : $(PERL_INC)perl.h, $(PERL_INC)perly.h, $(PERL_INC)pp.h, $(PERL_INC)proto.h
 $(OBJECT) : $(PERL_INC)regcomp.h, $(PERL_INC)regexp.h, $(PERL_INC)scope.h, $(PERL_INC)sv.h
 $(OBJECT) : $(PERL_INC)vmsish.h, $(PERL_INC)util.h, $(PERL_INC)config.h
+$(OBJECT) : $(PERL_INC)iperlsys.h
 
 ' if $self->{OBJECT}; 
 
@@ -2187,7 +2204,8 @@ $(MAP_TARGET) :: $(MAKE_APERL_FILE)
     }
 
 
-    my($linkcmd,@staticopts,@staticpkgs,$extralist,$targdir,$libperldir);
+    my($linkcmd,@optlibs,@staticpkgs,$extralist,$targdir,$libperldir,%libseen);
+    local($_);
 
     # The front matter of the linkcommand...
     $linkcmd = join ' ', $Config{'ld'},
@@ -2250,28 +2268,46 @@ $(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 keys %olbs) {
+    for (sort { length($a) <=> length($b) } keys %olbs) {
        next unless $olbs{$_} =~ /\Q$self->{LIB_EXT}\E$/;
        my($dir) = $self->fixpath($_,1);
        my($extralibs) = $dir . "extralibs.ld";
        my($extopt) = $dir . $olbs{$_};
        $extopt =~ s/$self->{LIB_EXT}$/.opt/;
+       push @optlibs, "$dir$olbs{$_}";
+       # Get external libraries this extension will need
        if (-f $extralibs ) {
+           my %seenthis;
            open LIST,$extralibs or warn $!,next;
-           push @$extra, <LIST>;
+           while (<LIST>) {
+               chomp;
+               # Include a library in the link only once, unless it's mentioned
+               # multiple times within a single extension's options file, in which
+               # case we assume the builder needed to search it again later in the
+               # link.
+               my $skip = exists($libseen{$_}) && !exists($seenthis{$_});
+               $libseen{$_}++;  $seenthis{$_}++;
+               next if $skip;
+               push @$extra,$_;
+           }
            close LIST;
        }
+       # Get full name of extension for ExtUtils::Miniperl
        if (-f $extopt) {
            open OPT,$extopt or die $!;
            while (<OPT>) {
                next unless /(?:UNIVERSAL|VECTOR)=boot_([\w_]+)/;
-               # ExtUtils::Miniperl expects Unix paths
-               (my($pkg) = "$1_$1$self->{LIB_EXT}") =~ s#_*#/#g;
+               my $pkg = $1;
+               $pkg =~ s#__*#::#g;
                push @staticpkgs,$pkg;
            }
-           push @staticopts, $extopt;
        }
     }
+    # Place all of the external libraries after all of the Perl extension
+    # libraries in the final link, in order to maximize the opportunity
+    # for XS code from multiple extensions to resolve symbols against the
+    # same external library while only including that library once.
+    push @optlibs, @$extra;
 
     $target = "Perl$Config{'exe_ext'}" unless $target;
     ($shrtarget,$targdir) = fileparse($target);
@@ -2280,11 +2316,11 @@ $(MAP_TARGET) :: $(MAKE_APERL_FILE)
     $target = "Perlshr.$Config{'dlext'}" unless $target;
     $tmp = "[]" unless $tmp;
     $tmp = $self->fixpath($tmp,1);
-    if (@$extra) {
-       $extralist = join(' ',@$extra);
-       $extralist =~ s/[,\s\n]+/, /g;
-    }
-    else { $extralist = ''; }
+    if (@optlibs) { $extralist = join(' ',@optlibs); }
+    else          { $extralist = ''; }
+    # Let ExtUtils::Liblist find the necessary libs for us (but skip PerlShr)
+    # that's what we're building here).
+    push @optlibs, grep { !/PerlShr/i } split ' ', +($self->ext())[2];
     if ($libperl) {
        unless (-f $libperl || -f ($libperl = $self->catfile($Config{'installarchlib'},'CORE',$libperl))) {
            print STDOUT "Warning: $libperl not found\n";
@@ -2308,19 +2344,22 @@ $(MAP_TARGET) :: $(MAKE_APERL_FILE)
 MAP_TARGET    = ',$self->fixpath($target,0),'
 MAP_SHRTARGET = ',$self->fixpath($shrtarget,0),"
 MAP_LINKCMD   = $linkcmd
-MAP_PERLINC   = ", $perlinc ? map('"$_" ',@{$perlinc}) : '','
-# We use the linker options files created with each extension, rather than
-#specifying the object files directly on the command line.
-MAP_STATIC    = ',@staticopts ? join(' ', @staticopts) : '','
-MAP_OPTS    = ',@staticopts ? ','.join(',', map($_.'/Option', @staticopts)) : '',"
+MAP_PERLINC   = ", $perlinc ? map('"$_" ',@{$perlinc}) : '',"
 MAP_EXTRA     = $extralist
 MAP_LIBPERL = ",$self->fixpath($libperl,0),'
 ';
 
 
-    push @m,'
-$(MAP_SHRTARGET) : $(MAP_LIBPERL) $(MAP_STATIC) ',"${libperldir}Perlshr_Attr.Opt",'
-       $(MAP_LINKCMD)/Shareable=$(MMS$TARGET) $(MAP_OPTS), $(MAP_EXTRA), $(MAP_LIBPERL) ',"${libperldir}Perlshr_Attr.Opt",'
+    push @m,"\n${tmp}Makeaperl.Opt : \$(MAP_EXTRA)\n";
+    foreach (@optlibs) {
+       push @m,'       $(NOECHO) $(PERL) -e "print q{',$_,'}" >>$(MMS$TARGET)',"\n";
+    }
+    push @m,"\n${tmp}PerlShr.Opt :\n\t";
+    push @m,'$(NOECHO) $(PERL) -e "print q{$(MAP_SHRTARGET)}" >$(MMS$TARGET)',"\n";
+
+push @m,'
+$(MAP_SHRTARGET) : $(MAP_LIBPERL) Makeaperl.Opt ',"${libperldir}Perlshr_Attr.Opt",'
+       $(MAP_LINKCMD)/Shareable=$(MMS$TARGET) $(MAP_LIBPERL), Makeaperl.Opt/Option ',"${libperldir}Perlshr_Attr.Opt/Option",'
 $(MAP_TARGET) : $(MAP_SHRTARGET) ',"${tmp}perlmain\$(OBJ_EXT) ${tmp}PerlShr.Opt",'
        $(MAP_LINKCMD) ',"${tmp}perlmain\$(OBJ_EXT)",', PerlShr.Opt/Option
        $(NOECHO) $(SAY) "To install the new ""$(MAP_TARGET)"" binary, say"
@@ -2328,13 +2367,17 @@ $(MAP_TARGET) : $(MAP_SHRTARGET) ',"${tmp}perlmain\$(OBJ_EXT) ${tmp}PerlShr.Opt"
        $(NOECHO) $(SAY) "To remove the intermediate files, say
        $(NOECHO) $(SAY) "    $(MMS)$(MMSQUALIFIERS)$(USEMAKEFILE)$(MAKEFILE) map_clean"
 ';
-    push @m,'
-',"${tmp}perlmain.c",' : $(MAKEFILE)
-       $(NOECHO) $(PERL) $(MAP_PERLINC) -e "use ExtUtils::Miniperl; writemain(qw|',@staticpkgs,'|)" >$(MMS$TARGET)
-';
+    push @m,"\n${tmp}perlmain.c : \$(MAKEFILE)\n\t\$(NOECHO) \$(PERL) -e 1 >${tmp}Writemain.tmp\n";
+    push @m, "# More from the 255-char line length limit\n";
+    foreach (@staticpkgs) {
+       push @m,'       $(NOECHO) $(PERL) -e "print q{',$_,qq[}" >>${tmp}Writemain.tmp\n];
+    }
+       push @m,'
+       $(NOECHO) $(PERL) $(MAP_PERLINC) -ane "use ExtUtils::Miniperl; writemain(@F)" ',$tmp,'Writemain.tmp >$(MMS$TARGET)
+       $(NOECHO) $(RM_F) ',"${tmp}Writemain.tmp\n";
 
     push @m, q[
-# More from the 255-char line length limit
+# Still more from the 255-char line length limit
 doc_inst_perl :
        $(NOECHO) $(PERL) -e "print 'Perl binary $(MAP_TARGET)|'" >.MM_tmp
        $(NOECHO) $(PERL) -e "print 'MAP_STATIC|$(MAP_STATIC)|'" >>.MM_tmp
@@ -2357,7 +2400,7 @@ clean :: map_clean
 
 map_clean :
        \$(RM_F) ${tmp}perlmain\$(OBJ_EXT) ${tmp}perlmain.c \$(MAKEFILE)
-       \$(RM_F) ${tmp}PerlShr.Opt \$(MAP_TARGET)
+       \$(RM_F) ${tmp}Makeaperl.Opt ${tmp}PerlShr.Opt \$(MAP_TARGET)
 ";
 
     join '', @m;