This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Now that ExtUtils::ParseXS requires 5.006, we can replace the foreach
[perl5.git] / lib / ExtUtils / ParseXS.pm
index 0729397..4c519fc 100644 (file)
@@ -18,7 +18,7 @@ my(@XSStack); # Stack of conditionals and INCLUDEs
 my($XSS_work_idx, $cpp_next_tmp);
 
 use vars qw($VERSION);
-$VERSION = '2.16_01';
+$VERSION = '2.18_01';
 
 use vars qw(%input_expr %output_expr $ProtoUsed @InitFileCode $FH $proto_re $Overload $errors $Fallback
            $cplusplus $hiertype $WantPrototypes $WantVersionChk $except $WantLineNumbers
@@ -193,8 +193,8 @@ sub process_file {
     close(TYPEMAP);
   }
 
-  foreach my $key (keys %input_expr) {
-    $input_expr{$key} =~ s/;*\s+\z//;
+  foreach my $value (values %input_expr) {
+    $value =~ s/;*\s+\z//;
   }
 
   my ($cast, $size);
@@ -203,8 +203,7 @@ sub process_file {
   $size = qr[,\s* (??{ $bal }) ]x; # Third arg (to setpvn)
 
   foreach my $key (keys %output_expr) {
-    #use re 'eval';
-    BEGIN { $^H |= 0x00200000};
+    BEGIN { $^H |= 0x00200000 }; # Equivalent to: use re 'eval', but hardcoded so we can compile re.xs
 
     my ($t, $with_size, $arg, $sarg) =
       ($output_expr{$key} =~
@@ -361,7 +360,7 @@ EOF
           ." followed by a statement on column one?)")
       if $line[0] =~ /^\s/;
     
-    my ($class, $externC, $static, $elipsis, $wantRETVAL, $RETVAL_no_return);
+    my ($class, $externC, $static, $ellipsis, $wantRETVAL, $RETVAL_no_return);
     my (@fake_INPUT_pre);      # For length(s) generated variables
     my (@fake_INPUT);
     
@@ -457,7 +456,7 @@ EOF
                                             \b ( \w+ | length\( \s*\w+\s* \) )
                                             \s* $ /x);
          next unless defined($pre) && length($pre);
-         my $out_type;
+         my $out_type = '';
          my $inout_var;
          if ($process_inout and s/^(IN|IN_OUTLIST|OUTLIST|OUT|IN_OUT)\s+//) {
            my $type = $1;
@@ -514,7 +513,7 @@ EOF
     my $report_args = '';
     foreach my $i (0 .. $#args) {
       if ($args[$i] =~ s/\.\.\.//) {
-       $elipsis = 1;
+       $ellipsis = 1;
        if ($args[$i] eq '' && $i == $#args) {
          $report_args .= ", ...";
          pop(@args);
@@ -578,7 +577,7 @@ EOF
     print Q(<<"EOF") if $INTERFACE ;
 #    dXSFUNCTION($ret_type);
 EOF
-    if ($elipsis) {
+    if ($ellipsis) {
       $cond = ($min_args ? qq(items < $min_args) : 0);
     } elsif ($min_args == $num_args) {
       $cond = qq(items != $min_args);
@@ -594,12 +593,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 
@@ -843,7 +842,7 @@ EOF
          $proto_arg[$min_args] .= ";" ;
        }
        push @proto_arg, "$s\@"
-         if $elipsis ;
+         if $ellipsis ;
        
        $proto = join ("", grep defined, @proto_arg);
       }
@@ -981,6 +980,13 @@ EOF
     print "\n    /* End of Initialisation Section */\n\n" ;
   }
 
+  if ($] >= 5.009) {
+    print <<'EOF';
+    if (PL_unitcheckav)
+         call_list(PL_scopestack_ix, PL_unitcheckav);
+EOF
+  }
+
   print Q(<<"EOF");
 #    XSRETURN_YES;
 #]]