}
my ($t, $tab, %curargs, $new, $eval_index, $dir, $name, $args, $outfile);
-my ($incl, $incl_type, $next);
+my ($incl, $incl_type, $incl_quote, $next);
while (defined (my $file = next_file())) {
if (-l $file and -d $file) {
link_if_possible($file) if ($opt_l);
print OUT
"require '_h2ph_pre.ph';\n\n",
- "no warnings 'redefine';\n\n";
+ "no warnings qw(redefine misc);\n\n";
while (defined (local $_ = next_line($file))) {
if (s/^\s*\#\s*//) {
$curargs{$arg} = 1;
}
$args =~ s/\b(\w)/\$$1/g;
- $args = "local($args) = \@_;\n$t ";
+ $args = "my($args) = \@_;\n$t ";
}
s/^\s+//;
expr();
print OUT $t,"unless(defined(\&$name)) {\n sub $name () {\t",$new,";}\n}\n";
}
}
- } elsif (/^(include|import|include_next)\s*[<\"](.*)[>\"]/) {
+ } elsif (/^(include|import|include_next)\s*([<\"])(.*)[>\"]/) {
$incl_type = $1;
- $incl = $2;
+ $incl_quote = $2;
+ $incl = $3;
if (($incl_type eq 'include_next') ||
($opt_e && exists($bad_file{$incl}))) {
$incl =~ s/\.h$/.ph/;
"warn(\$\@) if \$\@;\n");
} else {
$incl =~ s/\.h$/.ph/;
+ # copy the prefix in the quote syntax (#include "x.h") case
+ if ($incl !~ m|/| && $incl_quote eq q{"} && $file =~ m|^(.*)/|) {
+ $incl = "$1/$incl";
+ }
print OUT $t,"require '$incl';\n";
}
} elsif (/^ifdef\s+(\w+)/) {
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;
}
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) {
"unless defined(\&$enum_name);\n");
}
}
- } elsif (/^(?:__extension__\s+)?(?:extern|static)\s+(?:__)?inline(?:__)?\s+/) { # { for vi
+ } elsif (/^(?:__extension__\s+)?(?:extern|static)\s+(?:__)?inline(?:__)?\s+/
+ and !/;\s*$/ and !/{\s*}\s*$/)
+ { # { for vi
# This is a hack to parse the inline functions in the glibc headers.
- # Warning: massive kludge ahead. We suppose inline functions are mainly
- # constructed like macros.
+ # Warning: massive kludge ahead. We suppose inline functions
+ # are mainly constructed like macros.
while (1) {
last unless defined ($next = next_line($file));
chomp $next;
- undef $_, last if $next =~ /__THROW\s*;/;
+ undef $_, last if $next =~ /__THROW\s*;/
+ or $next =~ /^(__extension__|extern|static)\b/;
$_ .= " $next";
print OUT "# $next\n" if $opt_D;
last if $next =~ /^}|^{.*}\s*$/;
}
$args = (
@args
- ? "local(" . (join ',', map "\$$_", @args) . ") = \@_;\n$t "
+ ? "my(" . (join ',', map "\$$_", @args) . ") = \@_;\n$t "
: ""
);
my $proto = @args ? '' : '() ';
use re "eval";
my $typelist = join '|', keys %isatype;
$new =~ s['
+ (?:(?:__)?const(?:__)?\s+)?
(?:(?:un)?signed\s+)?
(?:long\s+)?
(?:$typelist)\s+
']
[my \$$1]gx;
$new =~ s['
+ (?:(?:__)?const(?:__)?\s+)?
(?:(?:un)?signed\s+)?
(?:long\s+)?
(?:$typelist)\s+
exit $Exit;
sub expr {
+ $new = '"(assembly code)"' and return if /\b__asm__\b/; # freak out.
my $joined_args;
if(keys(%curargs)) {
$joined_args = join('|', keys(%curargs));
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}) {
}
} else {
if ($inif && $new !~ /defined\s*\($/) {
- $new .= '(defined(&' . $id . ') ? &' . $id . ' : 0)';
+ $new .= '(defined(&' . $id . ') ? &' . $id . ' : undef)';
} elsif (/^\[/) {
$new .= " \$$id";
} else {
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; # | ??!| ||
$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
$line .= <HEADER>;
}
- if ($line =~ /^#\s*include\s+<(.*?)>/) {
- push(@ARGV, $1) unless $Is_converted{$1};
+ if ($line =~ /^#\s*include\s+([<"])(.*?)[>"]/) {
+ my ($delimiter, $new_file) = ($1, $2);
+ # copy the prefix in the quote syntax (#include "x.h") case
+ if ($delimiter eq q{"} && $file =~ m|^(.*)/|) {
+ $new_file = "$1/$new_file";
+ }
+ push(@ARGV, $new_file) unless $Is_converted{$new_file};
}
}
close HEADER;
# Determine include directories; $Config{usrinc} should be enough for (all
-# non-GCC?) C compilers, but gcc uses an additional include directory.
+# non-GCC?) C compilers, but gcc uses additional include directories.
sub inc_dirs
{
- my $from_gcc = `$Config{cc} -v 2>&1`;
- $from_gcc =~ s:^Reading specs from (.*?)/specs\b.*:$1/include:s;
-
- length($from_gcc) ? ($from_gcc, $Config{usrinc}) : ($Config{usrinc});
+ 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, $from_gcc . "-fixed", $Config{usrinc}) : ($Config{usrinc});
}
my (%define) = _extract_cc_defines();
open PREAMBLE, ">$preamble" or die "Cannot open $preamble: $!";
- print PREAMBLE "# This file was created by h2ph version $VERSION\n";
+ print PREAMBLE "# This file was created by h2ph version $VERSION\n";
- foreach (sort keys %define) {
- if ($opt_D) {
- print PREAMBLE "# $_=$define{$_}\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";
+ }
+ }
+ print PREAMBLE "\n1;\n"; # avoid 'did not return a true value' when empty
close PREAMBLE or die "Cannot close $preamble: $!";
}
{
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;
=item -d destination_dir
Put the resulting B<.ph> files beneath B<destination_dir>, instead of
-beneath the default Perl library location (C<$Config{'installsitsearch'}>).
+beneath the default Perl library location (C<$Config{'installsitearch'}>).
=item -r
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
};