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 4ff0d38..085e852 100755 (executable)
--- a/lib/ExtUtils/xsubpp
+++ b/lib/ExtUtils/xsubpp
@@ -249,9 +249,9 @@ foreach $key (keys %input_expr) {
     $input_expr{$key} =~ s/\n+$//;
 }
 
-$bal = qr[(?:(?>[^()]+)|\((?p{ $bal })\))*];   # ()-balanced
+$bal = qr[(?:(?>[^()]+)|\((??{ $bal })\))*];   # ()-balanced
 $cast = qr[(?:\(\s*SV\s*\*\s*\)\s*)?];         # Optional (SV*) cast
-$size = qr[,\s* (?p{ $bal }) ]x;               # Third arg (to setpvn)
+$size = qr[,\s* (??{ $bal }) ]x;               # Third arg (to setpvn)
 
 foreach $key (keys %output_expr) {
     use re 'eval';
@@ -260,8 +260,8 @@ foreach $key (keys %output_expr) {
       ($output_expr{$key} =~
         m[^ \s+ sv_set ( [iunp] ) v (n)?       # Type, is_setpvn
             \s* \( \s* $cast \$arg \s* ,
-            \s* ( (?p{ $bal }) )               # Set from
-            ( (?p{ $size }) )?                 # Possible sizeof set-from
+            \s* ( (??{ $bal }) )               # Set from
+            ( (??{ $size }) )?                 # Possible sizeof set-from
             \) \s* ; \s* $
          ]x);
     $targetable{$key} = [$t, $with_size, $arg, $sarg] if $t;
@@ -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.
@@ -287,11 +287,11 @@ sub check_keyword {
 my ($C_group_rex, $C_arg);
 # Group in C (no support for comments or literals)
 $C_group_rex = qr/ [({\[]
-                  (?: (?> [^()\[\]{}]+ ) | (?p{ $C_group_rex }) )*
+                  (?: (?> [^()\[\]{}]+ ) | (??{ $C_group_rex }) )*
                   [)}\]] /x ;
 # Chunk in C without comma at toplevel (no comments):
 $C_arg = qr/ (?: (?> [^()\[\]{},"']+ )
-            |   (?p{ $C_group_rex })
+            |   (??{ $C_group_rex })
             |   " (?: (?> [^\\"]+ )
                   |   \\.
                   )* "         # String literal
@@ -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
@@ -1029,8 +1029,8 @@ while (fetch_para()) {
     my %out_vars;
     if ($process_argtypes and $orig_args =~ /\S/) {
        my $args = "$orig_args ,";
-       if ($args =~ /^( (?p{ $C_arg }) , )* $ /x) {
-           @args = ($args =~ /\G ( (?p{ $C_arg }) ) , /xg);
+       if ($args =~ /^( (??{ $C_arg }) , )* $ /x) {
+           @args = ($args =~ /\G ( (??{ $C_arg }) ) , /xg);
            for ( @args ) {
                s/^\s+//;
                s/\s+$//;
@@ -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;
@@ -1576,7 +1577,7 @@ sub generate_init {
              eval qq/print "\\t$var;\\n"/;
              warn $@   if  $@;
            }
-           if ($defaults{$var} eq 'undef') {
+           if ($defaults{$var} eq 'NO_INIT') {
                $deferred .= eval qq/"\\n\\tif (items >= $num) {\\n$expr;\\n\\t}\\n"/;
            } else {
                $deferred .= eval qq/"\\n\\tif (items < $num)\\n\\t    $var = $defaults{$var};\\n\\telse {\\n$expr;\\n\\t}\\n"/;
@@ -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;