Clean up format of dlopen() debug info

[p5sagit/p5-mst-13.2.git] / lib / ExtUtils / xsubpp

diff --git a/lib/ExtUtils/xsubpp b/lib/ExtUtils/xsubpp
index 76e45d6..0cc8d78 100755 (executable)
--- a/lib/ExtUtils/xsubpp
+++ b/lib/ExtUtils/xsubpp
@@ -75,13 +75,25 @@ perl(1), perlxs(1), perlxstut(1), perlxs(1)
 
 =cut
 
-# Global Constants
-$XSUBPP_version = "1.940";
 require 5.002;
+use Cwd;
 use vars '$cplusplus';
 
 sub Q ;
 
+# Global Constants
+
+$XSUBPP_version = "1.9402";
+
+my ($Is_VMS, $SymSet);
+if ($^O eq 'VMS') {
+    $Is_VMS = 1;
+    # Establish set of global symbols with max length 28, since xsubpp
+    # will later add the 'XS_' prefix.
+    require ExtUtils::XSSymSet;
+    $SymSet = new ExtUtils::XSSymSet 28;
+}
+
 $FH = 'File0000' ;
 
 $usage = "Usage: xsubpp [-v] [-C++] [-except] [-prototypes] [-noversioncheck] [-s pattern] [-typemap typemap]... file.xs\n";
@@ -118,16 +130,14 @@ else
        or ($dir, $filename) = $ARGV[0] =~ m#(.*[>\]])(.*)#
        or ($dir, $filename) = ('.', $ARGV[0]);
 chdir($dir);
-# Check for VMS; Config.pm may not be installed yet, but this routine
-# is built into VMS perl
-if (defined(&VMS::Filespec::vmsify)) { $Is_VMS = 1; $pwd = $ENV{DEFAULT}; }
-else                                 { $Is_VMS = 0; chomp($pwd = `pwd`);   }
+$pwd = cwd();
 
 ++ $IncludedFiles{$ARGV[0]} ;
 
 my(@XSStack) = ({type => 'none'});     # Stack of conditionals and INCLUDEs
 my($XSS_work_idx, $cpp_next_tmp) = (0, "XSubPPtmpAAAA");
 
+
 sub TrimWhitespace
 {
     $_[0] =~ s/^\s+|\s+$//go ;
@@ -798,6 +808,7 @@ while (fetch_para()) {
     ($pname = $func_name) =~ s/^($Prefix)?/$Packprefix/;
     ($clean_func_name = $func_name) =~ s/^$Prefix//;
     $Full_func_name = "${Packid}_$clean_func_name";
+    if ($Is_VMS) { $Full_func_name = $SymSet->addsym($Full_func_name); }
 
     # Check for duplicate function definition
     for $tmp (@XSStack) {
@@ -842,7 +853,10 @@ while (fetch_para()) {
 
     $PPCODE = grep(/^\s*PPCODE\s*:/, @line);
     $CODE = grep(/^\s*CODE\s*:/, @line);
-    $EXPLICIT_RETURN = $CODE && ("@line" =~ /\bST\s*\([^;]*=/ );
+    # Detect CODE: blocks which use ST(n)= or XST_m*(n,v)
+    #   to set explicit return values.
+    $EXPLICIT_RETURN = ($CODE &&
+               ("@line" =~ /(\bST\s*\([^;]*=) | (\bXST_m\w+\s*\()/x ));
     $ALIAS  = grep(/^\s*ALIAS\s*:/,  @line);
 
     # print function header
@@ -1295,5 +1309,6 @@ sub Exit {
 # If this is VMS, the exit status has meaning to the shell, so we
 # use a predictable value (SS$_Normal or SS$_Abort) rather than an
 # arbitrary number.
-    exit ($Is_VMS ? ($errors ? 44 : 1) : $errors) ;
+#    exit ($Is_VMS ? ($errors ? 44 : 1) : $errors) ;
+    exit ($errors ? 1 : 0);
 }