Updating ExtUtils-ParseXS to 2.20
[p5sagit/p5-mst-13.2.git] / lib / ExtUtils / Mksymlists.pm
index cc4aca1..5aa6ef7 100644 (file)
@@ -1,18 +1,20 @@
 package ExtUtils::Mksymlists;
+
+use 5.006;
 use strict qw[ subs refs ];
 # no strict 'vars';  # until filehandles are exempted
 
 use Carp;
-use Config;
 use Exporter;
-# mention vars twice to prevent single-use warnings
-@ExtUtils::Mksymlists::ISA = @ExtUtils::Mksymlists::ISA = 'Exporter';
-@ExtUtils::Mksymlists::EXPORT = @ExtUtils::Mksymlists::EXPORT = '&Mksymlists';
-$ExtUtils::Mksymlists::VERSION = $ExtUtils::Mksymlists::VERSION = '1.00';
+use Config;
+
+our @ISA = qw(Exporter);
+our @EXPORT = qw(&Mksymlists);
+our $VERSION = '6.53_02';
 
 sub Mksymlists {
     my(%spec) = @_;
-    my($osname) = $Config{'osname'};
+    my($osname) = $^O;
 
     croak("Insufficient information specified to Mksymlists")
         unless ( $spec{NAME} or
@@ -20,36 +22,42 @@ sub Mksymlists {
 
     $spec{DL_VARS} = [] unless $spec{DL_VARS};
     ($spec{FILE} = $spec{NAME}) =~ s/.*::// unless $spec{FILE};
+    $spec{FUNCLIST} = [] unless $spec{FUNCLIST};
     $spec{DL_FUNCS} = { $spec{NAME} => [] }
         unless ( ($spec{DL_FUNCS} and keys %{$spec{DL_FUNCS}}) or
-                 $spec{FUNCLIST});
-    $spec{FUNCLIST} = [] unless $spec{FUNCLIST};
+                 @{$spec{FUNCLIST}});
     if (defined $spec{DL_FUNCS}) {
-        my($package);
-        foreach $package (keys %{$spec{DL_FUNCS}}) {
-            my($packprefix,$sym,$bootseen);
+        foreach my $package (keys %{$spec{DL_FUNCS}}) {
+            my($packprefix,$bootseen);
             ($packprefix = $package) =~ s/\W/_/g;
-            foreach $sym (@{$spec{DL_FUNCS}->{$package}}) {
+            foreach my $sym (@{$spec{DL_FUNCS}->{$package}}) {
                 if ($sym =~ /^boot_/) {
                     push(@{$spec{FUNCLIST}},$sym);
                     $bootseen++;
                 }
-                else { push(@{$spec{FUNCLIST}},"XS_${packprefix}_$sym"); }
+                else {
+                    push(@{$spec{FUNCLIST}},"XS_${packprefix}_$sym");
+                }
             }
             push(@{$spec{FUNCLIST}},"boot_$packprefix") unless $bootseen;
         }
     }
 
 #    We'll need this if we ever add any OS which uses mod2fname
+#    not as pseudo-builtin.
 #    require DynaLoader;
-#    if (defined &DynaLoader::mod2fname and not $spec{DLBASE}) {
-#        $spec{DLBASE} = DynaLoader::mod2fname([ split(/::/,$spec{NAME}) ]);
-#    }
+    if (defined &DynaLoader::mod2fname and not $spec{DLBASE}) {
+        $spec{DLBASE} = DynaLoader::mod2fname([ split(/::/,$spec{NAME}) ]);
+    }
 
     if    ($osname eq 'aix') { _write_aix(\%spec); }
+    elsif ($osname eq 'MacOS'){ _write_aix(\%spec) }
     elsif ($osname eq 'VMS') { _write_vms(\%spec) }
-    elsif ($osname eq 'OS2') { _write_os2(\%spec) }
-    else { croak("Don't know how to create linker option file for $osname\n"); }
+    elsif ($osname eq 'os2') { _write_os2(\%spec) }
+    elsif ($osname eq 'MSWin32') { _write_win32(\%spec) }
+    else {
+        croak("Don't know how to create linker option file for $osname\n");
+    }
 }
 
 
@@ -58,43 +66,113 @@ sub _write_aix {
 
     rename "$data->{FILE}.exp", "$data->{FILE}.exp_old";
 
-    open(EXP,">$data->{FILE}.exp")
+    open( my $exp, ">", "$data->{FILE}.exp")
         or croak("Can't create $data->{FILE}.exp: $!\n");
-    print EXP join("\n",@{$data->{DL_VARS}}, "\n") if @{$data->{DL_VARS}};
-    print EXP join("\n",@{$data->{FUNCLIST}}, "\n") if @{$data->{FUNCLIST}};
-    close EXP;
+    print $exp join("\n",@{$data->{DL_VARS}}, "\n") if @{$data->{DL_VARS}};
+    print $exp join("\n",@{$data->{FUNCLIST}}, "\n") if @{$data->{FUNCLIST}};
+    close $exp;
 }
 
 
 sub _write_os2 {
     my($data) = @_;
+    require Config;
+    my $threaded = ($Config::Config{archname} =~ /-thread/ ? " threaded" : "");
 
     if (not $data->{DLBASE}) {
         ($data->{DLBASE} = $data->{NAME}) =~ s/.*:://;
         $data->{DLBASE} = substr($data->{DLBASE},0,7) . '_';
     }
+    my $distname = $data->{DISTNAME} || $data->{NAME};
+    $distname = "Distribution $distname";
+    my $patchlevel = " pl$Config{perl_patchlevel}" || '';
+    my $comment = sprintf "Perl (v%s%s%s) module %s", 
+      $Config::Config{version}, $threaded, $patchlevel, $data->{NAME};
+    chomp $comment;
+    if ($data->{INSTALLDIRS} and $data->{INSTALLDIRS} eq 'perl') {
+        $distname = 'perl5-porters@perl.org';
+        $comment = "Core $comment";
+    }
+    $comment = "$comment (Perl-config: $Config{config_args})";
+    $comment = substr($comment, 0, 200) . "...)" if length $comment > 203;
     rename "$data->{FILE}.def", "$data->{FILE}_def.old";
 
-    open(DEF,">$data->{FILE}.def")
+    open(my $def, ">", "$data->{FILE}.def")
         or croak("Can't create $data->{FILE}.def: $!\n");
-    print DEF "LIBRARY '$data->{DLBASE}' INITINSTANCE TERMINSTANCE\n";
-    print DEF "CODE LOADONCALL\n";
-    print DEF "DATA LOADONCALL NONSHARED MULTIPLE\n";
-    print DEF "EXPORTS\n";
-    print DEF join("\n",@{$data->{DL_VARS}}, "\n") if @{$data->{DL_VARS}};
-    print DEF join("\n",@{$data->{FUNCLIST}}, "\n") if @{$data->{FUNCLIST}};
-    close DEF;
+    print $def "LIBRARY '$data->{DLBASE}' INITINSTANCE TERMINSTANCE\n";
+    print $def "DESCRIPTION '\@#$distname:$data->{VERSION}#\@ $comment'\n";
+    print $def "CODE LOADONCALL\n";
+    print $def "DATA LOADONCALL NONSHARED MULTIPLE\n";
+    print $def "EXPORTS\n  ";
+    print $def join("\n  ",@{$data->{DL_VARS}}, "\n") if @{$data->{DL_VARS}};
+    print $def join("\n  ",@{$data->{FUNCLIST}}, "\n") if @{$data->{FUNCLIST}};
+    if (%{$data->{IMPORTS}}) {
+        print $def "IMPORTS\n";
+        my ($name, $exp);
+        while (($name, $exp)= each %{$data->{IMPORTS}}) {
+            print $def "  $name=$exp\n";
+        }
+    }
+    close $def;
+}
+
+sub _write_win32 {
+    my($data) = @_;
+
+    require Config;
+    if (not $data->{DLBASE}) {
+        ($data->{DLBASE} = $data->{NAME}) =~ s/.*:://;
+        $data->{DLBASE} = substr($data->{DLBASE},0,7) . '_';
+    }
+    rename "$data->{FILE}.def", "$data->{FILE}_def.old";
+
+    open( my $def, ">", "$data->{FILE}.def" )
+        or croak("Can't create $data->{FILE}.def: $!\n");
+    # put library name in quotes (it could be a keyword, like 'Alias')
+    if ($Config::Config{'cc'} !~ /^gcc/i) {
+        print $def "LIBRARY \"$data->{DLBASE}\"\n";
+    }
+    print $def "EXPORTS\n  ";
+    my @syms;
+    # Export public symbols both with and without underscores to
+    # ensure compatibility between DLLs from different compilers
+    # NOTE: DynaLoader itself only uses the names without underscores,
+    # so this is only to cover the case when the extension DLL may be
+    # linked to directly from C. GSAR 97-07-10
+    if ($Config::Config{'cc'} =~ /^bcc/i) {
+        for (@{$data->{DL_VARS}}, @{$data->{FUNCLIST}}) {
+            push @syms, "_$_", "$_ = _$_";
+        }
+    }
+    else {
+        for (@{$data->{DL_VARS}}, @{$data->{FUNCLIST}}) {
+            push @syms, "$_", "_$_ = $_";
+        }
+    }
+    print $def join("\n  ",@syms, "\n") if @syms;
+    if (%{$data->{IMPORTS}}) {
+        print $def "IMPORTS\n";
+        my ($name, $exp);
+        while (($name, $exp)= each %{$data->{IMPORTS}}) {
+            print $def "  $name=$exp\n";
+        }
+    }
+    close $def;
 }
 
 
 sub _write_vms {
     my($data) = @_;
-    my($isvax) = $Config{'arch'} =~ /VAX/i;
-    my($sym);
+
+    require Config; # a reminder for once we do $^O
+    require ExtUtils::XSSymSet;
+
+    my($isvax) = $Config::Config{'archname'} =~ /VAX/i;
+    my($set) = new ExtUtils::XSSymSet;
 
     rename "$data->{FILE}.opt", "$data->{FILE}.opt_old";
 
-    open(OPT,">$data->{FILE}.opt")
+    open(my $opt,">", "$data->{FILE}.opt")
         or croak("Can't create $data->{FILE}.opt: $!\n");
 
     # Options file declaring universal symbols
@@ -104,24 +182,23 @@ sub _write_vms {
     # We don't do anything to preserve order, so we won't relax
     # the GSMATCH criteria for a dynamic extension
 
-    foreach $sym (@{$data->{FUNCLIST}}) {
-        if ($isvax) { print OPT "UNIVERSAL=$sym\n" }
-        else        { print OPT "SYMBOL_VECTOR=($sym=PROCEDURE)\n"; }
+    print $opt "case_sensitive=yes\n"
+        if $Config::Config{d_vms_case_sensitive_symbols};
+
+    foreach my $sym (@{$data->{FUNCLIST}}) {
+        my $safe = $set->addsym($sym);
+        if ($isvax) { print $opt "UNIVERSAL=$safe\n" }
+        else        { print $opt "SYMBOL_VECTOR=($safe=PROCEDURE)\n"; }
     }
-    foreach $sym (@{$data->{DL_VARS}}) {
-        print OPT "PSECT_ATTR=${sym},PIC,OVR,RD,NOEXE,WRT,NOSHR\n";
-        if ($isvax) { print OPT "UNIVERSAL=$sym\n" }
-        else        { print OPT "SYMBOL_VECTOR=($sym=DATA)\n"; }
+
+    foreach my $sym (@{$data->{DL_VARS}}) {
+        my $safe = $set->addsym($sym);
+        print $opt "PSECT_ATTR=${sym},PIC,OVR,RD,NOEXE,WRT,NOSHR\n";
+        if ($isvax) { print $opt "UNIVERSAL=$safe\n" }
+        else        { print $opt "SYMBOL_VECTOR=($safe=DATA)\n"; }
     }
-    close OPT;
-
-    # Options file specifying RTLs to which this extension must be linked.
-    # Eventually, the list of libraries will be supplied by a working
-    # extliblist routine.
-    open OPT,'>rtls.opt';
-    print OPT "PerlShr/Share\n";
-    foreach $rtl (split(/\s+/,$Config{'libs'})) { print OPT "$rtl\n"; }
-    close OPT;
+    
+    close $opt;
 }
 
 1;
@@ -143,17 +220,22 @@ ExtUtils::Mksymlists - write linker options files for dynamic extension
 =head1 DESCRIPTION
 
 C<ExtUtils::Mksymlists> produces files used by the linker under some OSs
-during the creation of shared libraries for synamic extensions.  It is
+during the creation of shared libraries for dynamic extensions.  It is
 normally called from a MakeMaker-generated Makefile when the extension
 is built.  The linker option file is generated by calling the function
 C<Mksymlists>, which is exported by default from C<ExtUtils::Mksymlists>.
 It takes one argument, a list of key-value pairs, in which the following
 keys are recognized:
 
-=item NAME
+=over 4
 
-This gives the name of the extension (I<e.g.> Tk::Canvas) for which
-the linker option file will be produced.
+=item DLBASE
+
+This item specifies the name by which the linker knows the
+extension, which may be different from the name of the
+extension itself (for instance, some linkers add an '_' to the
+name of the extension).  If it is not specified, it is derived
+from the NAME attribute.  It is presently used only by OS2 and Win32.
 
 =item DL_FUNCS
 
@@ -186,7 +268,7 @@ be exported by the extension.
 This key can be used to specify the name of the linker option file
 (minus the OS-specific extension), if for some reason you do not
 want to use the default value, which is the last word of the NAME
-attribute (I<e.g.> for Tk::Canvas, FILE defaults to 'Canvas').
+attribute (I<e.g.> for C<Tk::Canvas>, FILE defaults to C<Canvas>).
 
 =item FUNCLIST
 
@@ -194,14 +276,27 @@ This provides an alternate means to specify function names to be
 exported from the extension.  Its value is a reference to an
 array of function names to be exported by the extension.  These
 names are passed through unaltered to the linker options file.
+Specifying a value for the FUNCLIST attribute suppresses automatic
+generation of the bootstrap function for the package. To still create
+the bootstrap name you have to specify the package name in the
+DL_FUNCS hash:
 
-=item DLBASE
+    Mksymlists({ NAME     => $name ,
+                FUNCLIST => [ $func1, $func2 ],
+                 DL_FUNCS => { $pkg => [] } });
 
-This item specifies the name by which the linker knows the
-extension, which may be different from the name of the
-extension itself (for instance, some linkers add an '_' to the
-name of the extension).  If it is not specified, it is derived
-from the NAME attribute.  It is presently used only by OS2.
+
+=item IMPORTS
+
+This attribute is used to specify names to be imported into the
+extension. It is currently only used by OS/2 and Win32.
+
+=item NAME
+
+This gives the name of the extension (I<e.g.> C<Tk::Canvas>) for which
+the linker option file will be produced.
+
+=back
 
 When calling C<Mksymlists>, one should always specify the NAME
 attribute.  In most cases, this is all that's necessary.  In
@@ -210,8 +305,8 @@ can be used to provide additional information to the linker.
 
 =head1 AUTHOR
 
-Charles Bailey I<E<lt>bailey@genetics.upenn.eduE<gt>>
+Charles Bailey I<E<lt>bailey@newman.upenn.eduE<gt>>
 
 =head1 REVISION
 
-Last revised 14-Jan-1996, for Perl 5.002.
+Last revised 14-Feb-1996, for Perl 5.002.