From: John Tobey Date: Thu, 7 Aug 1997 00:00:00 +0000 (+0000) Subject: xsubpp patch X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6f1abe2b022469d02f6d0ced94b9c90cbb1362c6;p=p5sagit%2Fp5-mst-13.2.git xsubpp patch The patch below is against the 5.004_01 distribution's xsubpp and incorporates your changes. > From: Gurusamy Sarathy > > 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 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 --- 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 [B<-v>] [B<-C++>] [B<-except>] [B<-s pattern>] [B<-prototypes>] [B<-noversioncheck>] [B<-typemap typemap>]... file.xs +B [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 <) { 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