Merge changes from CPAN's EU:MM 6.30_01.
[p5sagit/p5-mst-13.2.git] / utils / h2ph.PL
index f715f50..5fe2e9f 100644 (file)
@@ -142,7 +142,7 @@ while (defined (my $file = next_file())) {
                            $curargs{$arg} = 1;
                        }
                        $args =~ s/\b(\w)/\$$1/g;
-                       $args = "local($args) = \@_;\n$t    ";
+                       $args = "my($args) = \@_;\n$t    ";
                    }
                    s/^\s+//;
                    expr();
@@ -276,6 +276,8 @@ while (defined (my $file = next_file())) {
                chomp $next;
                # drop "#define FOO FOO" in enums
                $next =~ s/^\s*#\s*define\s+(\w+)\s+\1\s*$//;
+               # #defines in enums (aliases)
+               $next =~ s/^\s*#\s*define\s+(\w+)\s+(\w+)\s*$/$1 = $2,/;
                $_ .= $next;
                print OUT "# $next\n" if $opt_D;
            }
@@ -288,6 +290,7 @@ while (defined (my $file = next_file())) {
            my $enum_val = -1;
            foreach my $enum (@enum_subs) {
                my ($enum_name, $enum_value) = $enum =~ /^([a-zA-Z_]\w*)(=.+)?$/;
+               $enum_name or next;
                $enum_value =~ s/^=//;
                $enum_val = (length($enum_value) ? $enum_value : $enum_val + 1);
                if ($opt_h) {
@@ -338,7 +341,7 @@ while (defined (my $file = next_file())) {
            }
            $args = (
                @args
-               ? "local(" . (join ',', map "\$$_", @args) . ") = \@_;\n$t    "
+               ? "my(" . (join ',', map "\$$_", @args) . ") = \@_;\n$t    "
                : ""
            );
            my $proto = @args ? '' : '() ';
@@ -351,6 +354,7 @@ while (defined (my $file = next_file())) {
                use re "eval";
                my $typelist = join '|', keys %isatype;
                $new =~ s['
+                 (?:(?:__)?const(?:__)?\s+)?
                  (?:(?:un)?signed\s+)?
                  (?:long\s+)?
                  (?:$typelist)\s+
@@ -359,6 +363,7 @@ while (defined (my $file = next_file())) {
                  ']
                 [my \$$1]gx;
                $new =~ s['
+                 (?:(?:__)?const(?:__)?\s+)?
                  (?:(?:un)?signed\s+)?
                  (?:long\s+)?
                  (?:$typelist)\s+
@@ -400,7 +405,7 @@ sub expr {
        s/^\&\&// && do { $new .= " &&"; next;}; # handle && operator
        s/^\&([\(a-z\)]+)/$1/i; # hack for things that take the address of
        s/^(\s+)//              && do {$new .= ' '; next;};
-       s/^0X([0-9A-F]+)[UL]*//i 
+       s/^0X([0-9A-F]+)[UL]*//i
            && do {my $hex = $1;
                   $hex =~ s/^0+//;
                   if (length $hex > 8 && !$Config{use64bitint}) {
@@ -536,7 +541,7 @@ sub next_line
 
         while (length $in) {
             if ($pre_sub_tri_graphs) {
-                # Preprocess all tri-graphs 
+                # Preprocess all tri-graphs
                 # including things stuck in quoted string constants.
                 $in =~ s/\?\?=/#/g;                         # | ??=|  #|
                 $in =~ s/\?\?\!/|/g;                        # | ??!|  ||
@@ -549,17 +554,19 @@ sub next_line
                 $in =~ s/\?\?>/}/g;                         # | ??>|  }|
             }
            if ($in =~ /^\#ifdef __LANGUAGE_PASCAL__/) {
-                # Tru64 disassembler.h evilness: mixed C and Pascal.
+               # Tru64 disassembler.h evilness: mixed C and Pascal.
                while (<IN>) {
-                   last if /^\#endif/; 
+                   last if /^\#endif/;
                }
+               $in = "";
                next READ;
            }
            if ($in =~ /^extern inline / && # Inlined assembler.
                $^O eq 'linux' && $file =~ m!(?:^|/)asm/[^/]+\.h$!) {
-               while (<IN>) {
-                   last if /^}/; 
+               while (<IN>) {
+                   last if /^}/;
                }
+               $in = "";
                next READ;
            }
             if ($in =~ s/\\$//) {                           # \-newline
@@ -729,9 +736,15 @@ sub queue_includes_from
 # non-GCC?) C compilers, but gcc uses an additional include directory.
 sub inc_dirs
 {
-    my $from_gcc    = `$Config{cc} -v 2>&1`;
-    $from_gcc       =~ s:^Reading specs from (.*?)/specs\b.*:$1/include:s;
-
+    my $from_gcc    = `LC_ALL=C $Config{cc} -v 2>&1`;
+    if( !( $from_gcc =~ s:^Reading specs from (.*?)/specs\b.*:$1/include:s ) )
+    { # gcc-4+ :
+       $from_gcc   = `LC_ALL=C $Config{cc} -print-search-dirs 2>&1`;
+       if ( !($from_gcc =~ s/^install:\s*([^\s]+[^\s\/])([\s\/]*).*$/$1\/include/s) )
+       {
+           $from_gcc = '';
+       };
+    };
     length($from_gcc) ? ($from_gcc, $Config{usrinc}) : ($Config{usrinc});
 }
 
@@ -759,25 +772,33 @@ sub build_preamble_if_necessary
     my (%define) = _extract_cc_defines();
 
     open  PREAMBLE, ">$preamble" or die "Cannot open $preamble:  $!";
-        print PREAMBLE "# This file was created by h2ph version $VERSION\n";
-
-        foreach (sort keys %define) {
-            if ($opt_D) {
-                print PREAMBLE "# $_=$define{$_}\n";
-            }
+       print PREAMBLE "# This file was created by h2ph version $VERSION\n";
 
-            if ($define{$_} =~ /^(\d+)U?L{0,2}$/i) {
-                print PREAMBLE
-                    "unless (defined &$_) { sub $_() { $1 } }\n\n";
-            } elsif ($define{$_} =~ /^\w+$/) {
-                print PREAMBLE
-                    "unless (defined &$_) { sub $_() { &$define{$_} } }\n\n";
-            } else {
-                print PREAMBLE
-                    "unless (defined &$_) { sub $_() { \"",
-                    quotemeta($define{$_}), "\" } }\n\n";
-            }
-        }
+       foreach (sort keys %define) {
+           if ($opt_D) {
+               print PREAMBLE "# $_=$define{$_}\n";
+           }
+           if ($define{$_} =~ /^\((.*)\)$/) {
+               # parenthesized value:  d=(v)
+               $define{$_} = $1;
+           }
+           if ($define{$_} =~ /^([+-]?(\d+)?\.\d+([eE][+-]?\d+)?)[FL]?$/) {
+               # float:
+               print PREAMBLE
+                   "unless (defined &$_) { sub $_() { $1 } }\n\n";
+           } elsif ($define{$_} =~ /^([+-]?\d+)U?L{0,2}$/i) {
+               # integer:
+               print PREAMBLE
+                   "unless (defined &$_) { sub $_() { $1 } }\n\n";
+           } elsif ($define{$_} =~ /^\w+$/) {
+               print PREAMBLE
+                   "unless (defined &$_) { sub $_() { &$define{$_} } }\n\n";
+           } else {
+               print PREAMBLE
+                   "unless (defined &$_) { sub $_() { \"",
+                   quotemeta($define{$_}), "\" } }\n\n";
+           }
+       }
     close PREAMBLE               or die "Cannot close $preamble:  $!";
 }
 
@@ -789,15 +810,14 @@ sub _extract_cc_defines
 {
     my %define;
     my $allsymbols  = join " ",
-        @Config{'ccsymbols', 'cppsymbols', 'cppccsymbols'};
+       @Config{'ccsymbols', 'cppsymbols', 'cppccsymbols'};
 
     # Split compiler pre-definitions into `key=value' pairs:
-    foreach (split /\s+/, $allsymbols) {
-        /(.+?)=(.+)/ and $define{$1} = $2;
-
-        if ($opt_D) {
-            print STDERR "$_:  $1 -> $2\n";
-        }
+    while ($allsymbols =~ /([^\s]+)=((\\\s|[^\s])+)/g) {
+       $define{$1} = $2;
+       if ($opt_D) {
+           print STDERR "$_:  $1 -> $2\n";
+       }
     }
 
     return %define;
@@ -932,10 +952,10 @@ installation.
 Doesn't handle complicated expressions built piecemeal, a la:
 
     enum {
-        FIRST_VALUE,
-        SECOND_VALUE,
+       FIRST_VALUE,
+       SECOND_VALUE,
     #ifdef ABC
-        THIRD_VALUE
+       THIRD_VALUE
     #endif
     };