integrate cfgperl contents into mainline

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

diff --git a/lib/ExtUtils/xsubpp b/lib/ExtUtils/xsubpp
index ff66b22..085e852 100755 (executable)
--- a/lib/ExtUtils/xsubpp
+++ b/lib/ExtUtils/xsubpp
@@ -273,7 +273,7 @@ $END = "!End!\n\n";         # "impossible" keyword (multiple newline)
 $BLOCK_re= '\s*(' . join('|', qw(
        REQUIRE BOOT CASE PREINIT INPUT INIT CODE PPCODE OUTPUT 
        CLEANUP ALIAS PROTOTYPES PROTOTYPE VERSIONCHECK INCLUDE
-       SCOPE INTERFACE INTERFACE_MACRO C_ARGS POST_CALL
+       SCOPE INTERFACE INTERFACE_MACRO C_ARGS POSTCALL
        )) . "|$END)\\s*:";
 
 # Input:  ($_, @line) == unparsed input.
@@ -436,7 +436,7 @@ sub INPUT_handler {
            $func_args =~ s/\b($var_name)\b/&$1/;
        }
        if ($var_init =~ /^[=;]\s*NO_INIT\s*;?\s*$/
-           or $in_out{$var_name} and $in_out{$var_name} eq 'outlist'
+           or $in_out{$var_name} and $in_out{$var_name} eq 'OUTLIST'
            and $var_init !~ /\S/) {
          if ($name_printed) {
            print ";\n";
@@ -522,7 +522,7 @@ EOF
 
 sub CLEANUP_handler() { print_section() } 
 sub PREINIT_handler() { print_section() } 
-sub POST_CALL_handler() { print_section() } 
+sub POSTCALL_handler() { print_section() } 
 sub INIT_handler()    { print_section() } 
 
 sub GetAliases
@@ -1041,10 +1041,10 @@ while (fetch_para()) {
                next unless length $pre;
                my $out_type;
                my $inout_var;
-               if ($process_inout and s/^(in|in_outlist|outlist)\s+//) {
+               if ($process_inout and s/^(IN|IN_OUTLIST|OUTLIST)\s+//) {
                    my $type = $1;
-                   $out_type = $type if $type ne 'in';
-                   $arg =~ s/^(in|in_outlist|outlist)\s+//;
+                   $out_type = $type if $type ne 'IN';
+                   $arg =~ s/^(IN|IN_OUTLIST|OUTLIST)\s+//;
                }
                if (/\W/) {     # Has a type
                    push @arg_with_types, $arg;
@@ -1052,7 +1052,7 @@ while (fetch_para()) {
                    $arg_types{$name} = $arg;
                    $_ = "$name$default";
                }
-               $out_vars{$_} = 1 if $out_type eq 'outlist';
+               $out_vars{$_} = 1 if $out_type eq 'OUTLIST';
                push @in_out, $name if $out_type;
                $in_out{$name} = $out_type if $out_type;
            }
@@ -1063,10 +1063,10 @@ while (fetch_para()) {
     } else {
        @args = split(/\s*,\s*/, $orig_args);
        for (@args) {
-           if ($process_inout and s/^(in|in_outlist|outlist)\s+//) {
+           if ($process_inout and s/^(IN|IN_OUTLIST|OUTLIST)\s+//) {
                my $out_type = $1;
-               next if $out_type eq 'in';
-               $out_vars{$_} = 1 if $out_type eq 'outlist';
+               next if $out_type eq 'IN';
+               $out_vars{$_} = 1 if $out_type eq 'OUTLIST';
                push @in_out, $name;
                $in_out{$_} = $out_type;
            }
@@ -1278,7 +1278,7 @@ EOF
        # $wantRETVAL set if 'RETVAL =' autogenerated
        ($wantRETVAL, $ret_type) = (0, 'void') if $RETVAL_no_return;
        undef %outargs ;
-       process_keyword("POST_CALL|OUTPUT|ALIAS|PROTOTYPE"); 
+       process_keyword("POSTCALL|OUTPUT|ALIAS|PROTOTYPE"); 
 
        # all OUTPUT done, so now push the return value on the stack
        if ($gotRETVAL && $RETVAL_code) {
@@ -1544,17 +1544,18 @@ sub generate_init {
        unless defined($type_kind{$type});
 
     ($ntype = $type) =~ s/\s*\*/Ptr/g;
+    $ntype =~ s/^\s*const\b\s*//;
     ($subtype = $ntype) =~ s/(?:Array)?(?:Ptr)?$//;
     $tk = $type_kind{$type};
     $tk =~ s/OBJ$/REF/ if $func_name =~ /DESTROY$/;
     $type =~ tr/:/_/;
-    blurt("Error: No INPUT definition for type '$type' found"), return
+    blurt("Error: No INPUT definition for type '$type', typekind '$type_kind{$type}' found"), return
         unless defined $input_expr{$tk} ;
     $expr = $input_expr{$tk};
     if ($expr =~ /DO_ARRAY_ELEM/) {
         blurt("Error: '$subtype' not in typemap"), return 
            unless defined($type_kind{$subtype});
-        blurt("Error: No INPUT definition for type '$subtype' found"), return
+        blurt("Error: No INPUT definition for type '$subtype', typekind '$type_kind{$subtype}' found"), return
             unless defined $input_expr{$type_kind{$subtype}} ;
        $subexpr = $input_expr{$type_kind{$subtype}};
        $subexpr =~ s/ntype/subtype/g;
@@ -1612,7 +1613,7 @@ sub generate_output {
     } else {
            blurt("Error: '$type' not in typemap"), return
                unless defined($type_kind{$type});
-            blurt("Error: No OUTPUT definition for type '$type' found"), return
+            blurt("Error: No OUTPUT definition for type '$type', typekind '$type_kind{$type}' found"), return
                 unless defined $output_expr{$type_kind{$type}} ;
            ($ntype = $type) =~ s/\s*\*/Ptr/g;
            $ntype =~ s/\(\)//g;
@@ -1621,7 +1622,7 @@ sub generate_output {
            if ($expr =~ /DO_ARRAY_ELEM/) {
                blurt("Error: '$subtype' not in typemap"), return
                    unless defined($type_kind{$subtype});
-                blurt("Error: No OUTPUT definition for type '$subtype' found"), return
+                blurt("Error: No OUTPUT definition for type '$subtype', typekind '$type_kind{$subtype}' found"), return
                     unless defined $output_expr{$type_kind{$subtype}} ;
                $subexpr = $output_expr{$type_kind{$subtype}};
                $subexpr =~ s/ntype/subtype/g;