From: Perl 5 Porters <perl5-porters@africa.nicoh.com> Date: Wed, 10 Jul 1996 21:20:32 +0000 (+0000) Subject: perl 5.003_01: lib/ExtUtils/xsubpp X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=93d3b392e52f4dbaeb643dd62c1be55b27ef77d4;p=p5sagit%2Fp5-mst-13.2.git 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 --- diff --git a/lib/ExtUtils/xsubpp b/lib/ExtUtils/xsubpp index 8554bb5..13f54b4 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"; }