xsubpp patch

The patch below is against the 5.004_01 distribution's xsubpp and
incorporates your changes.

> From: Gurusamy Sarathy <gsar@engin.umich.edu>
>
> On Mon, 30 Jun 1997 03:16:25 EDT, Ilya Zakharevich wrote:
> >John Tobey sent me a remarkable fix for xsubpp bugs with #line
> >directives.  I did check a previous version of his patch, and it
> >worked flawlessly, with the only drawback that it did not #line'ized
> >BOOT directives.
> >
> >Today I got his next version, and he claims it now handles BOOT too.
> >I think it may go even to the maintainance track.
>
> Not until the issues below are resolved.  I've attached a patch
> that fixes all but one.

I believe it's possible to avoid any subprocesses or shell invocations
by using a tied filehandle.

Getting the output filename right will require restructuring xsubpp's
command line interface and changing MakeMaker, whence my ".c" hack.
Given that the previous xsubpp didn't insert any self-pointing line
directives, I figure it's a gain, though by no means perfect.

The tie idea may improve portability at the expense of length and
complexity.  It's worked in my test cases (unlike my last patch, in
which C<splice(@BootCode, 1)> should be C<@BootCode> as you noticed).
However, I feel I'm on thin ice when using TIEHANDLE, and this code
can certainly be smoothed out a bit.

p5p-msgid: 199707010221.CAA01234@remote133

diff --git a/lib/ExtUtils/xsubpp b/lib/ExtUtils/xsubpp
index 6c83e1b..ac1378d 100755 (executable)
--- a/lib/ExtUtils/xsubpp
+++ b/lib/ExtUtils/xsubpp
@@ -6,7 +6,7 @@ xsubpp - compiler to convert Perl XS code into C code
 
 =head1 SYNOPSIS
 
-B<xsubpp> [B<-v>] [B<-C++>] [B<-except>] [B<-s pattern>] [B<-prototypes>] [B<-noversioncheck>] [B<-typemap typemap>]... file.xs
+B<xsubpp> [B<-v>] [B<-C++>] [B<-except>] [B<-s pattern>] [B<-prototypes>] [B<-noversioncheck>] [B<-nolinenumbers>] [B<-typemap typemap>]... file.xs
 
 =head1 DESCRIPTION
 
@@ -55,6 +55,10 @@ Disables the run time test that determines if the object file (derived
 from the C<.xs> file) and the C<.pm> files have the same version
 number.
 
+=item B<-nolinenumbers>
+
+Prevents the inclusion of `#line' directives in the output.
+
 =back
 
 =head1 ENVIRONMENT
@@ -83,7 +87,7 @@ sub Q ;
 
 # Global Constants
 
-$XSUBPP_version = "1.9402";
+$XSUBPP_version = "1.9504";
 
 my ($Is_VMS, $SymSet);
 if ($^O eq 'VMS') {
@@ -96,7 +100,7 @@ if ($^O eq 'VMS') {
 
 $FH = 'File0000' ;
 
-$usage = "Usage: xsubpp [-v] [-C++] [-except] [-prototypes] [-noversioncheck] [-s pattern] [-typemap typemap]... file.xs\n";
+$usage = "Usage: xsubpp [-v] [-C++] [-except] [-prototypes] [-noversioncheck] [-nolinenumbers] [-s pattern] [-typemap typemap]... file.xs\n";
 
 $proto_re = "[" . quotemeta('\$%&*@;') . "]" ;
 
@@ -104,6 +108,7 @@ $except = "";
 $WantPrototypes = -1 ;
 $WantVersionChk = 1 ;
 $ProtoUsed = 0 ;
+$WantLineNumbers = 1 ;
 SWITCH: while (@ARGV and $ARGV[0] =~ /^-./) {
     $flag = shift @ARGV;
     $flag =~ s/^-// ;
@@ -115,6 +120,8 @@ SWITCH: while (@ARGV and $ARGV[0] =~ /^-./) {
     $WantVersionChk = 1, next SWITCH   if $flag eq 'versioncheck';
     $except = " TRY",  next SWITCH     if $flag eq 'except';
     push(@tm,shift),   next SWITCH     if $flag eq 'typemap';
+    $WantLineNumbers = 0, next SWITCH  if $flag eq 'nolinenumbers';
+    $WantLineNumbers = 1, next SWITCH  if $flag eq 'linenumbers';
     (print "xsubpp version $XSUBPP_version\n"), exit   
        if $flag eq 'v';
     die $usage;
@@ -239,13 +246,59 @@ sub check_keyword {
 }
 
 
+if ($WantLineNumbers) {
+    {
+       package xsubpp::counter;
+       sub TIEHANDLE {
+           my ($class, $cfile) = @_;
+           my $buf = "";
+           $SECTION_END_MARKER = "#line --- \"$cfile\"";
+           $line_no = 1;
+           bless \$buf;
+       }
+
+       sub PRINT {
+           my $self = shift;
+           for (@_) {
+               $$self .= $_;
+               while ($$self =~ s/^([^\n]*\n)//) {
+                   my $line = $1;
+                   ++ $line_no;
+                   $line =~ s|^\#line\s+---(?=\s)|#line $line_no|;
+                   print STDOUT $line;
+               }
+           }
+       }
+
+       sub PRINTF {
+           my $self = shift;
+           my $fmt = shift;
+           $self->PRINT(sprintf($fmt, @_));
+       }
+
+       sub DESTROY {
+           # Not necessary if we're careful to end with a "\n"
+           my $self = shift;
+           print STDOUT $$self;
+       }
+    }
+
+    my $cfile = $filename;
+    $cfile =~ s/\.xs$/.c/i or $cfile .= ".c";
+    tie(*PSEUDO_STDOUT, 'xsubpp::counter', $cfile);
+    select PSEUDO_STDOUT;
+}
+
 sub print_section {
-    my $count = 0;
-    $_ = shift(@line) while !/\S/ && @line;
+    # the "do" is required for right semantics
+    do { $_ = shift(@line) } while !/\S/ && @line;
+    
+    print("#line ", $line_no[@line_no - @line -1], " \"$filename\"\n")
+       if $WantLineNumbers && !/^\s*#\s*line\b/;
     for (;  defined($_) && !/^$BLOCK_re/o;  $_ = shift(@line)) {
-        print line_directive() unless ($count++);
        print "$_\n";
     }
+    print "$xsubpp::counter::SECTION_END_MARKER\n" if $WantLineNumbers;
 }
 
 sub process_keyword($)
@@ -255,7 +308,6 @@ sub process_keyword($)
 
     &{"${kwd}_handler"}() 
         while $kwd = check_keyword($pattern) ;
-    print line_directive();
 }
 
 sub CASE_handler {
@@ -332,7 +384,6 @@ sub OUTPUT_handler {
            unless defined($args_match{$outarg});
        blurt("Error: No input definition for OUTPUT argument '$outarg' - ignored"), next
            unless defined $var_types{$outarg} ;
-       print line_directive();
        if ($outcode) {
            print "\t$outcode\n";
        } else {
@@ -650,7 +701,10 @@ print <<EOM ;
  */
 
 EOM
-print "#line 1 \"$filename\"\n"; 
+ 
+
+print("#line 1 \"$filename\"\n")
+    if $WantLineNumbers;
 
 while (<$FH>) {
     last if ($Module, $Package, $Prefix) =
@@ -787,7 +841,9 @@ while (fetch_para()) {
 
     if (check_keyword("BOOT")) {
        &check_cpp;
-        push (@BootCode, $_, line_directive(), @line, "") ;
+       push (@BootCode, "#line $line_no[@line_no - @line] \"$filename\"")
+         if $WantLineNumbers && $line[0] !~ /^\s*#\s*line\b/;
+        push (@BootCode, @line, "") ;
         next PARAGRAPH ;
     }
 
@@ -1005,7 +1061,6 @@ EOF
        } elsif ($gotRETVAL || $wantRETVAL) {
            &generate_output($ret_type, 0, 'RETVAL');
        }
-       print line_directive();
 
        # do cleanup
        process_keyword("CLEANUP|ALIAS|PROTOTYPE") ;
@@ -1064,11 +1119,11 @@ EOF
     if ($ProtoThisXSUB) {
        $newXS = "newXSproto";
 
-       if ($ProtoThisXSUB == 2) {
+       if ($ProtoThisXSUB eq 2) {
            # User has specified empty prototype
            $proto = ', ""' ;
        }
-        elsif ($ProtoThisXSUB != 1) {
+        elsif ($ProtoThisXSUB ne 1) {
             # User has specified a prototype
             $proto = ', "' . $ProtoThisXSUB . '"';
         }
@@ -1135,8 +1190,9 @@ EOF
 
 if (@BootCode)
 {
-    print "\n    /* Initialisation Section */\n" ;
-    print grep (s/$/\n/, @BootCode) ;
+    print "\n    /* Initialisation Section */\n\n" ;
+    @line = @BootCode;
+    print_section();
     print "\n    /* End of Initialisation Section */\n\n" ;
 }
 
@@ -1158,15 +1214,6 @@ sub output_init {
     eval qq/print " $init\\\n"/;
 }
 
-sub line_directive
-{
-    # work out the line number
-    my $line_no = $line_no[@line_no - @line -1] ;
- 
-    return "#line $line_no \"$filename\"\n" ;
-
-}
-
 sub Warn
 {
     # work out the line number