ParseXS.pm: small optimization for "Usage: ..." constant strings

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

diff --git a/lib/ExtUtils/ParseXS.pm b/lib/ExtUtils/ParseXS.pm
index bd0e875..a5db98d 100644 (file)
--- a/lib/ExtUtils/ParseXS.pm
+++ b/lib/ExtUtils/ParseXS.pm
@@ -5,6 +5,7 @@ use Cwd;
 use Config;
 use File::Basename;
 use File::Spec;
+use Symbol;
 
 require Exporter;
 
@@ -17,8 +18,7 @@ my(@XSStack); # Stack of conditionals and INCLUDEs
 my($XSS_work_idx, $cpp_next_tmp);
 
 use vars qw($VERSION);
-$VERSION = '2.09_01';
-$VERSION = eval $VERSION;
+$VERSION = '2.16_02';
 
 use vars qw(%input_expr %output_expr $ProtoUsed @InitFileCode $FH $proto_re $Overload $errors $Fallback
            $cplusplus $hiertype $WantPrototypes $WantVersionChk $except $WantLineNumbers
@@ -55,6 +55,7 @@ sub process_file {
           argtypes => 1,
           typemap => [],
           output => \*STDOUT,
+          csuffix => '.c',
           %args,
          );
 
@@ -71,7 +72,7 @@ sub process_file {
   @XSStack = ({type => 'none'});
   ($XSS_work_idx, $cpp_next_tmp) = (0, "XSubPPtmpAAAA");
   @InitFileCode = ();
-  $FH = 'File0000' ;
+  $FH = Symbol::gensym();
   $proto_re = "[" . quotemeta('\$%&*@;[]') . "]" ;
   $Overload = 0;
   $errors = 0;
@@ -118,6 +119,7 @@ sub process_file {
   
   chdir($dir);
   my $pwd = cwd();
+  my $csuffix = $args{csuffix};
   
   if ($WantLineNumbers) {
     my $cfile;
@@ -125,7 +127,7 @@ sub process_file {
       $cfile = $args{outfile};
     } else {
       $cfile = $args{filename};
-      $cfile =~ s/\.xs$/.c/i or $cfile .= ".c";
+      $cfile =~ s/\.xs$/$csuffix/i or $cfile .= $csuffix;
     }
     tie(*PSEUDO_STDOUT, 'ExtUtils::ParseXS::CountLines', $cfile, $args{output});
     select PSEUDO_STDOUT;
@@ -195,13 +197,14 @@ sub process_file {
     $input_expr{$key} =~ s/;*\s+\z//;
   }
 
-  my ($bal, $cast, $size);
-  $bal = qr[(?:(?>[^()]+)|\((??{ $bal })\))*]; # ()-balanced
+  my ($cast, $size);
+  our $bal = qr[(?:(?>[^()]+)|\((??{ $bal })\))*]; # ()-balanced
   $cast = qr[(?:\(\s*SV\s*\*\s*\)\s*)?]; # Optional (SV*) cast
   $size = qr[,\s* (??{ $bal }) ]x; # Third arg (to setpvn)
 
   foreach my $key (keys %output_expr) {
-    use re 'eval';
+    #use re 'eval';
+    BEGIN { $^H |= 0x00200000};
 
     my ($t, $with_size, $arg, $sarg) =
       ($output_expr{$key} =~
@@ -224,7 +227,7 @@ sub process_file {
                                  )) . "|$END)\\s*:";
 
   
-  my ($C_group_rex, $C_arg);
+  our ($C_group_rex, $C_arg);
   # Group in C (no support for comments or literals)
   $C_group_rex = qr/ [({\[]
                       (?: (?> [^()\[\]{}]+ ) | (??{ $C_group_rex }) )*
@@ -358,7 +361,7 @@ EOF
           ." followed by a statement on column one?)")
       if $line[0] =~ /^\s/;
     
-    my ($class, $static, $elipsis, $wantRETVAL, $RETVAL_no_return);
+    my ($class, $externC, $static, $elipsis, $wantRETVAL, $RETVAL_no_return);
     my (@fake_INPUT_pre);      # For length(s) generated variables
     my (@fake_INPUT);
     
@@ -412,7 +415,8 @@ EOF
     blurt ("Error: Function definition too short '$ret_type'"), next PARAGRAPH
       unless @line ;
 
-    $static = 1 if $ret_type =~ s/^static\s+//;
+    $externC = 1 if $ret_type =~ s/^extern "C"\s+//;
+    $static  = 1 if $ret_type =~ s/^static\s+//;
 
     $func_header = shift(@line);
     blurt ("Error: Cannot parse function definition from '$func_header'"), next PARAGRAPH
@@ -554,12 +558,19 @@ EOF
 
     $xsreturn = 1 if $EXPLICIT_RETURN;
 
+    $externC = $externC ? qq[extern "C"] : "";
+
     # print function header
     print Q(<<"EOF");
+#$externC
 #XS(XS_${Full_func_name}); /* prototype to pass -Wmissing-prototypes */
 #XS(XS_${Full_func_name})
 #[[
+##ifdef dVAR
+#    dVAR; dXSARGS;
+##else
 #    dXSARGS;
+##endif
 EOF
     print Q(<<"EOF") if $ALIAS ;
 #    dXSI32;
@@ -583,12 +594,12 @@ EOF
     if ($ALIAS)
       { print Q(<<"EOF") if $cond }
 #    if ($cond)
-#       Perl_croak(aTHX_ "Usage: %s($report_args)", GvNAME(CvGV(cv)));
+#       Perl_croak(aTHX_ "Usage: %s(%s)", GvNAME(CvGV(cv)), "$report_args");
 EOF
     else
       { print Q(<<"EOF") if $cond }
 #    if ($cond)
-#      Perl_croak(aTHX_ "Usage: $pname($report_args)");
+#       Perl_croak(aTHX_ "Usage: %s(%s)", "$pname", "$report_args");
 EOF
     
      # cv doesn't seem to be used, in most cases unless we go in 
@@ -913,7 +924,11 @@ EOF
 
   print Q(<<"EOF");
 #[[
+##ifdef dVAR
+#    dVAR; dXSARGS;
+##else
 #    dXSARGS;
+##endif
 EOF
 
   #-Wall: if there is no $Full_func_name there are no xsubs in this .xs
@@ -978,6 +993,7 @@ EOF
   chdir($orig_cwd);
   select($orig_fh);
   untie *PSEUDO_STDOUT if tied *PSEUDO_STDOUT;
+  close $FH;
 
   return 1;
 }
@@ -1206,7 +1222,9 @@ sub INTERFACE_handler() {
   TrimWhitespace($in);
 
   foreach (split /[\s,]+/, $in) {
-    $Interfaces{$_} = $_;
+    my $name = $_;
+    $name =~ s/^$Prefix//;
+    $Interfaces{$name} = $_;
   }
   print Q(<<"EOF");
 #      XSFUNCTION = $interface_macro($ret_type,cv,XSANY.any_dptr);
@@ -1431,10 +1449,11 @@ sub INCLUDE_handler ()
                    Line            => \@line,
                    LineNo          => \@line_no,
                    Filename        => $filename,
+                   Filepathname    => $filepathname,
                    Handle          => $FH,
                   }) ;
 
-    ++ $FH ;
+    $FH = Symbol::gensym();
 
     # open the new file
     open ($FH, "$_") or death("Cannot open '$_': $!") ;
@@ -1445,7 +1464,7 @@ sub INCLUDE_handler ()
 #
 EOF
 
-    $filename = $_ ;
+    $filepathname = $filename = $_ ;
 
     # Prime the pump by reading the first
     # non-blank line
@@ -1474,7 +1493,11 @@ sub PopFile()
     close $FH ;
 
     $FH         = $data->{Handle} ;
+    # $filename is the leafname, which for some reason isused for diagnostic
+    # messages, whereas $filepathname is the full pathname, and is used for
+    # #line directives.
     $filename   = $data->{Filename} ;
+    $filepathname = $data->{Filepathname} ;
     $lastline   = $data->{LastLine} ;
     $lastline_no = $data->{LastLineNo} ;
     @line       = @{ $data->{Line} } ;