perl 5.003_01: lib/ExtUtils/xsubpp

Update to version 1.937
Cosmetic changes for easier EMACS editing
First pass at correcting return type for void XSUBs

1 files changed, 19 insertions, 8 deletions

diff --git a/lib/ExtUtils/xsubpp b/lib/ExtUtils/xsubpp
index 8554bb5054..13f54b4855 100755
--- a/lib/ExtUtils/xsubpp
+++ b/lib/ExtUtils/xsubpp
@@ -76,7 +76,7 @@ perl(1), perlxs(1), perlxstut(1), perlapi(1)
 =cut
 
 # Global Constants
-$XSUBPP_version = "1.935";
+$XSUBPP_version = "1.937";
 require 5.002;
 use vars '$cplusplus';
 
@@ -183,7 +183,7 @@ foreach $typemap (@tm) {
             $type = TidyType($type) ;
 	    $type_kind{$type} = $kind ;
             # prototype defaults to '$'
-            $proto = '$' unless $proto ;
+            $proto = "\$" unless $proto ;
             warn("Warning: File '$typemap' Line $. '$line' Invalid prototype '$proto'\n") 
                 unless ValidProtoString($proto) ;
             $proto_letter{$type} = C_string($proto) ;
@@ -570,7 +570,7 @@ sub ProtoString ($)
 {
     my ($type) = @_ ;
 
-    $proto_letter{$type} or '$' ;
+    $proto_letter{$type} or "\$" ;
 }
 
 sub check_cpp {
@@ -608,7 +608,7 @@ open($FH, $filename) or die "cannot open $filename: $!\n";
 print <<EOM ;
 /*
  * This file was generated automatically by xsubpp version $XSUBPP_version from the 
- * contents of $filename. Don't edit this file, edit $filename instead.
+ * contents of $filename. Do not edit this file, edit $filename instead.
  *
  *	ANY CHANGES MADE HERE WILL BE LOST! 
  *
@@ -802,7 +802,7 @@ while (fetch_para()) {
 		    $defaults{$args[$i]} = $2;
 		    $defaults{$args[$i]} =~ s/"/\\"/g;
 	    }
-	    $proto_arg[$i+1] = '$' ;
+	    $proto_arg[$i+1] = "\$" ;
     }
     if (defined($class)) {
 	    $func_args = join(", ", @args[1..$#args]);
@@ -812,6 +812,7 @@ while (fetch_para()) {
     @args_match{@args} = 1..@args;
 
     $PPCODE = grep(/^\s*PPCODE\s*:/, @line);
+    $CODE = grep(/^\s*CODE\s*:/, @line);
     $ALIAS  = grep(/^\s*ALIAS\s*:/,  @line);
 
     # print function header
@@ -979,9 +980,15 @@ EOF
 #	croak(errbuf);
 EOF
 
-    print Q<<EOF unless $PPCODE;
+    if ($ret_type ne "void" or $CODE) {
+        print Q<<EOF unless $PPCODE;
 #    XSRETURN(1);
 EOF
+    } else {
+        print Q<<EOF unless $PPCODE;
+#    XSRETURN_EMPTY;
+EOF
+    }
 
     print Q<<EOF;
 #]]
@@ -1137,7 +1144,7 @@ sub generate_init {
 	$subexpr =~ s/ntype/subtype/g;
 	$subexpr =~ s/\$arg/ST(ix_$var)/g;
 	$subexpr =~ s/\n\t/\n\t\t/g;
-	$subexpr =~ s/is not of (.*")/[arg %d] is not of $1, ix_$var + 1/g;
+	$subexpr =~ s/is not of (.*\")/[arg %d] is not of $1, ix_$var + 1/g;
 	$subexpr =~ s/\$var/${var}[ix_$var - $argoff]/;
 	$expr =~ s/DO_ARRAY_ELEM/$subexpr/;
     }
@@ -1186,7 +1193,11 @@ sub generate_output {
 		eval "print qq\a$expr\a";
 	    }
 	    elsif ($var eq 'RETVAL') {
-		if ($expr =~ /^\t\$arg = /) {
+		if ($expr =~ /^\t\$arg\s*=\s*\$var\s*;/) {
+		    eval "print qq\a$expr\a";
+		    print "\tif (SvREFCNT(ST(0))) sv_2mortal(ST(0));\n";
+		} 
+		elsif ($expr =~ /^\t\$arg = /) {
 		    eval "print qq\a$expr\a";
 		    print "\tsv_2mortal(ST(0));\n";
 		}