}
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);
$t = '';
$tab = 0;
- # $eval_index goes into ``#line'' directives, to help locate syntax errors:
+ # $eval_index goes into '#line' directives, to help locate syntax errors:
$eval_index = 1;
if ($file eq '-') {
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*//) {
s/^\s+//;
expr();
$new =~ s/(["\\])/\\$1/g; #"]);
- EMIT:
- $new = reindent($new);
- $args = reindent($args);
- if ($t ne '') {
- $new =~ s/(['\\])/\\$1/g; #']);
- if ($opt_h) {
- print OUT $t,
- "eval \"\\n#line $eval_index $outfile\\n\" . 'sub $name $proto\{\n$t ${args}eval q($new);\n$t}' unless defined(\&$name);\n";
- $eval_index++;
- } else {
- print OUT $t,
- "eval 'sub $name $proto\{\n$t ${args}eval q($new);\n$t}' unless defined(\&$name);\n";
- }
- } else {
- print OUT "unless(defined(\&$name)) {\n sub $name $proto\{\n\t${args}eval q($new);\n }\n}\n";
- }
- %curargs = ();
+ EMIT($proto);
} else {
s/^\s+//;
expr();
+
$new = 1 if $new eq '';
+
+ # Shunt around such directives as '#define FOO FOO':
+ next if $new =~ /^\s*&\Q$name\E\s*\z/;
+
$new = reindent($new);
$args = reindent($args);
- if ($t ne '') {
- $new =~ s/(['\\])/\\$1/g; #']);
-
- if ($opt_h) {
- print OUT $t,"eval \"\\n#line $eval_index $outfile\\n\" . 'sub $name () {",$new,";}' unless defined(\&$name);\n";
- $eval_index++;
- } else {
- print OUT $t,"eval 'sub $name () {",$new,";}' unless defined(\&$name);\n";
- }
- } else {
- # Shunt around such directives as `#define FOO FOO':
- next if " \&$name" eq $new;
+ $new =~ s/(['\\])/\\$1/g; #']);
- print OUT $t,"unless(defined(\&$name)) {\n sub $name () {\t",$new,";}\n}\n";
+ print OUT $t, 'eval ';
+ if ($opt_h) {
+ print OUT "\"\\n#line $eval_index $outfile\\n\" . ";
+ $eval_index++;
}
+ print OUT "'sub $name () {$new;}' unless defined(&$name);\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+)/) {
$new =~ s/&$_\b/\$$_/g for @local_variables;
$new =~ s/(["\\])/\\$1/g; #"]);
# now that's almost like a macro (we hope)
- goto EMIT;
+ EMIT($proto);
}
}
$Is_converted{$file} = 1;
exit $Exit;
+sub EMIT {
+ my $proto = shift;
+
+ $new = reindent($new);
+ $args = reindent($args);
+ if ($t ne '') {
+ $new =~ s/(['\\])/\\$1/g; #']);
+ if ($opt_h) {
+ print OUT $t,
+ "eval \"\\n#line $eval_index $outfile\\n\" . 'sub $name $proto\{\n$t ${args}eval q($new);\n$t}' unless defined(\&$name);\n";
+ $eval_index++;
+ } else {
+ print OUT $t,
+ "eval 'sub $name $proto\{\n$t ${args}eval q($new);\n$t}' unless defined(\&$name);\n";
+ }
+ } else {
+ print OUT "unless(defined(\&$name)) {\n sub $name $proto\{\n\t${args}eval q($new);\n }\n}\n";
+ }
+ %curargs = ();
+ return;
+}
+
sub expr {
- $new = '"(assembly code)"' and return if /\b__asm__\b/; # freak out.
+ if (/\b__asm__\b/) { # freak out
+ $new = '"(assembly code)"';
+ return
+ }
my $joined_args;
if(keys(%curargs)) {
$joined_args = join('|', keys(%curargs));
# Croak if nv_preserves_uv_bits < 64 ?
$new .= hex(substr($hex, -8)) +
2**32 * hex(substr($hex, 0, -8));
- # The above will produce "errorneus" code
+ # The above will produce "erroneous" code
# if the hex constant was e.g. inside UINT64_C
# macro, but then again, h2ph is an approximation.
} else {
s/^\s*\((\w),/("$1",/ if $id =~ /^_IO[WR]*$/i; # cheat
$new .= " &$id";
} elsif ($isatype{$id}) {
- if ($new =~ /{\s*$/) {
+ if ($new =~ /\{\s*$/) {
$new .= "'$id'";
} elsif ($new =~ /\(\s*$/ && /^[\s*]*\)/) {
$new =~ s/\(\s*$//;
$new .= q(').$id.q(');
}
} else {
- if ($inif && $new !~ /defined\s*\($/) {
- $new .= '(defined(&' . $id . ') ? &' . $id . ' : undef)';
+ if ($inif) {
+ if ($new =~ /defined\s*$/) {
+ $new .= '(&' . $id . ')';
+ } elsif ($new =~ /defined\s*\($/) {
+ $new .= '&' . $id;
+ } else {
+ $new .= '(defined(&' . $id . ') ? &' . $id . ' : undef)';
+ }
} elsif (/^\[/) {
$new .= " \$$id";
} else {
if ($opt_r) {
expand_glob($file);
} else {
- print STDERR "Skipping directory `$file'\n";
+ print STDERR "Skipping directory '$file'\n";
}
} elsif ($opt_a) {
return $file;
} else {
- print STDERR "Skipping `$file': not a file or directory\n";
+ print STDERR "Skipping '$file': not a file or directory\n";
}
}
$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 = `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});
+ my $from_gcc = `LC_ALL=C $Config{cc} -v -E - < /dev/null 2>&1 | awk '/^#include/, /^End of search list/' | grep '^ '`;
+ length($from_gcc) ? (split(' ', $from_gcc), $Config{usrinc}) : ($Config{usrinc});
}
sub build_preamble_if_necessary
{
# Increment $VERSION every time this function is modified:
- my $VERSION = 2;
+ my $VERSION = 3;
my $preamble = "$Dest_dir/_h2ph_pre.ph";
# Can we skip building the preamble file?
# parenthesized value: d=(v)
$define{$_} = $1;
}
- if ($define{$_} =~ /^([+-]?(\d+)?\.\d+([eE][+-]?\d+)?)[FL]?$/) {
+ if (/^(\w+)\((\w)\)$/) {
+ my($macro, $arg) = ($1, $2);
+ my $def = $define{$_};
+ $def =~ s/$arg/\$\{$arg\}/g;
+ print PREAMBLE <<DEFINE;
+unless (defined &$macro) { sub $macro(\$) { my (\$$arg) = \@_; \"$def\" } }
+
+DEFINE
+ } elsif
+ ($define{$_} =~ /^([+-]?(\d+)?\.\d+([eE][+-]?\d+)?)[FL]?$/) {
# float:
print PREAMBLE
"unless (defined &$_) { sub $_() { $1 } }\n\n";
print PREAMBLE
"unless (defined &$_) { sub $_() { $1 } }\n\n";
} elsif ($define{$_} =~ /^\w+$/) {
- print PREAMBLE
- "unless (defined &$_) { sub $_() { &$define{$_} } }\n\n";
+ my $def = $define{$_};
+ if ($isatype{$def}) {
+ print PREAMBLE
+ "unless (defined &$_) { sub $_() { \"$def\" } }\n\n";
+ } else {
+ print PREAMBLE
+ "unless (defined &$_) { sub $_() { &$def } }\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 $allsymbols = join " ",
@Config{'ccsymbols', 'cppsymbols', 'cppccsymbols'};
- # Split compiler pre-definitions into `key=value' pairs:
+ # Split compiler pre-definitions into 'key=value' pairs:
while ($allsymbols =~ /([^\s]+)=((\\\s|[^\s])+)/g) {
$define{$1} = $2;
if ($opt_D) {
=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
=item -h
-Put ``hints'' in the .ph files which will help in locating problems with
+Put 'hints' in the .ph files which will help in locating problems with
I<h2ph>. In those cases when you B<require> a B<.ph> file containing syntax
errors, instead of the cryptic
=item -Q
-``Quiet'' mode; don't print out the names of the files being converted.
+'Quiet' mode; don't print out the names of the files being converted.
=back
https://perl5.git.perl.org / perl5.git / blobdiff