[perl #17222] [PATCH] h2ph and Fortran, other wacky headers on IRIX

From: Allen Smith (via RT) <perlbug@perl.org>
Message-Id: <rt-17222-37356.6.04859798196188@bugs6.perl.org>

p4raw-id: //depot/perl@17939

diff --git a/t/lib/h2ph.pht b/t/lib/h2ph.pht
index a52c160..796d6a8 100644 (file)
--- a/t/lib/h2ph.pht
+++ b/t/lib/h2ph.pht
@@ -48,8 +48,9 @@ unless(defined(&_H2PH_H_)) {
     require 'sys/socket.ph';
     require 'sys/ioctl.ph';
     eval {
+       my(@REM);
        my(%INCD) = map { $INC{$_} => 1 } (grep { $_ eq "sys/fcntl.ph" } keys(%INC));
-       my(@REM) = map { "$_/sys/fcntl.ph" } (grep { not exists($INCD{"$_/sys/fcntl.ph"})and -f "$_/sys/fcntl.ph" } @INC);
+       @REM = map { "$_/sys/fcntl.ph" } (grep { not exists($INCD{"$_/sys/fcntl.ph"}) and -f "$_/sys/fcntl.ph" } @INC);
        require "$REM[0]" if @REM;
     };
     warn($@) if $@;

diff --git a/utils/h2ph.PL b/utils/h2ph.PL
index 2868414..04dc132 100644 (file)
--- a/utils/h2ph.PL
+++ b/utils/h2ph.PL
@@ -42,8 +42,8 @@ use Config;
 use File::Path qw(mkpath);
 use Getopt::Std;
 
-getopts('Dd:rlhaQ');
-use vars qw($opt_D $opt_d $opt_r $opt_l $opt_h $opt_a $opt_Q);
+getopts('Dd:rlhaQe');
+use vars qw($opt_D $opt_d $opt_r $opt_l $opt_h $opt_a $opt_Q $opt_e);
 die "-r and -a options are mutually exclusive\n" if ($opt_r and $opt_a);
 my @inc_dirs = inc_dirs() if $opt_a;
 
@@ -65,13 +65,21 @@ my %isatype;
 @isatype{@isatype} = (1) x @isatype;
 my $inif = 0;
 my %Is_converted;
+my %bad_file = ();
 
 @ARGV = ('-') unless @ARGV;
 
 build_preamble_if_necessary();
 
+sub reindent($) {
+    my($text) = shift;
+    $text =~ s/\n/\n    /g;
+    $text =~ s/        /\t/g;
+    $text;
+}
+
 my ($t, $tab, %curargs, $new, $eval_index, $dir, $name, $args, $outfile);
-my ($incl, $next);
+my ($incl, $incl_type, $next);
 while (defined (my $file = next_file())) {
     if (-l $file and -d $file) {
         link_if_possible($file) if ($opt_l);
@@ -169,22 +177,31 @@ while (defined (my $file = next_file())) {
                       print OUT $t,"unless(defined(\&$name)) {\n    sub $name () {\t",$new,";}\n}\n";
                    }
                }
-           } elsif (/^(include|import)\s*[<"](.*)[>"]/) {
-               ($incl = $2) =~ s/\.h$/.ph/;
-               print OUT $t,"require '$incl';\n";
-           } elsif(/^include_next\s*[<"](.*)[>"]/) {
-               ($incl = $1) =~ s/\.h$/.ph/;
+           } elsif (/^(include|import|include_next)\s*[<\"](.*)[>\"]/) {
+                $incl_type = $1;
+                $incl = $2;
+                if (($incl_type eq 'include_next') ||
+                    ($opt_e && exists($bad_file{$incl}))) {
+                    $incl =~ s/\.h$/.ph/;
                print OUT ($t,
                           "eval {\n");
                 $tab += 4;
                 $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
+                    print OUT ($t, "my(\@REM);\n");
+                    if ($incl_type eq 'include_next') {
                print OUT ($t,
                           "my(\%INCD) = map { \$INC{\$_} => 1 } ",
-                          "(grep { \$_ eq \"$incl\" } keys(\%INC));\n");
+                                  "(grep { \$_ eq \"$incl\" } ",
+                                   "keys(\%INC));\n");
                print OUT ($t,
-                          "my(\@REM) = map { \"\$_/$incl\" } ",
+                                  "\@REM = map { \"\$_/$incl\" } ",
                           "(grep { not exists(\$INCD{\"\$_/$incl\"})",
-                          "and -f \"\$_/$incl\" } \@INC);\n");
+                                  " and -f \"\$_/$incl\" } \@INC);\n");
+                    } else {
+                        print OUT ($t,
+                                   "\@REM = map { \"\$_/$incl\" } ",
+                                   "(grep {-r \"\$_/$incl\" } \@INC);\n");
+                    }
                print OUT ($t,
                           "require \"\$REM[0]\" if \@REM;\n");
                 $tab -= 4;
@@ -193,6 +210,10 @@ while (defined (my $file = next_file())) {
                           "};\n");
                print OUT ($t,
                           "warn(\$\@) if \$\@;\n");
+                } else {
+                    $incl =~ s/\.h$/.ph/;
+                   print OUT $t,"require '$incl';\n";
+                }
            } elsif (/^ifdef\s+(\w+)/) {
                print OUT $t,"if(defined(&$1)) {\n";
                $tab += 4;
@@ -274,22 +295,22 @@ while (defined (my $file = next_file())) {
            }
        }
     }
-    print OUT "1;\n";
-
     $Is_converted{$file} = 1;
+    if ($opt_e && exists($bad_file{$file})) {
+        unlink($Dest_dir . '/' . $outfile);
+        $next = '';
+    } else {
+        print OUT "1;\n";
     queue_includes_from($file) if ($opt_a);
+    }
 }
 
-exit $Exit;
-
-
-sub reindent($) {
-    my($text) = shift;
-    $text =~ s/\n/\n    /g;
-    $text =~ s/        /\t/g;
-    $text;
+if ($opt_e && (scalar(keys %bad_file) > 0)) {
+    warn "Was unable to convert the following files:\n";
+    warn "\t" . join("\n\t",sort(keys %bad_file)) . "\n";
 }
 
+exit $Exit;
 
 sub expr {
     my $joined_args;
@@ -485,7 +506,15 @@ sub next_line
                      $in   =~ s!\'T KNOW!!) {
                 $out    =~ s!I DON$!I_DO_NOT_KNOW!;
             } else {
+                if ($opt_e) {
+                    warn "Cannot parse $file:\n$in\n";
+                    $bad_file{$file} = 1;
+                    $in = '';
+                    $out = undef;
+                    last READ;
+                } else {
                die "Cannot parse:\n$in\n";
+                }
             }
         }