X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=utils%2Fh2ph.PL;h=79039968768eb920be038e3497298af89ff9914d;hb=7589e17d81493a7065648e700081a252e10a5c33;hp=855a899499a3da55166d0a255e50543ccc858400;hpb=fc865b05a6e46dfadc1934cb061c1ccca0958ef7;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/utils/h2ph.PL b/utils/h2ph.PL
index 855a899..7903996 100644
--- a/utils/h2ph.PL
+++ b/utils/h2ph.PL
@@ -108,24 +108,7 @@ while (defined (my $file = next_file())) {
     }
 
     print OUT "require '_h2ph_pre.ph';\n\n";
-    while (<IN>) {
-	chop;
-	while (/\\$/) {
-	    chop;
-	    $_ .= <IN>;
-	    chop;
-	}
-	print OUT "# $_\n" if $opt_D;
-
-	if (s:/\*:\200:g) {
-	    s:\*/:\201:g;
-	    s/\200[^\201]*\201//g;	# delete single line comments
-	    if (s/\200.*//) {		# begin multi-line comment?
-		$_ .= '/*';
-		$_ .= <IN>;
-		redo;
-	    }
-	}
+    while (defined (local $_ = next_line())) {
 	if (s/^\s*\#\s*//) {
 	    if (s/^define\s+(\w+)//) {
 		$name = $1;
@@ -255,15 +238,19 @@ while (defined (my $file = next_file())) {
 	    } elsif(/^ident\s+(.*)/) {
 		print OUT $t, "# $1\n";
 	    }
- 	} elsif(/^\s*(typedef\s*)?enum\s*(\s+[a-zA-Z_]\w*\s*)?\{/) {
-	    until(/\}.*?;/) {
-		chomp($next = <IN>);
+	} elsif(/^\s*(typedef\s*)?enum\s*(\s+[a-zA-Z_]\w*\s*)?/) {
+	    until(/\{[^}]*\}.*;/ || /;/) {
+		last unless defined ($next = next_line());
+		chomp $next;
+		# drop "#define FOO FOO" in enums
+		$next =~ s/^\s*#\s*define\s+(\w+)\s+\1\s*$//;
 		$_ .= $next;
 		print OUT "# $next\n" if $opt_D;
 	    }
+	    s/#\s*if.*?#\s*endif//g; # drop #ifdefs
 	    s@/\*.*?\*/@@g;
 	    s/\s+/ /g;
-	    /^\s?(typedef\s?)?enum\s?([a-zA-Z_]\w*)?\s?\{(.*)\}\s?([a-zA-Z_]\w*)?\s?;/;
+	    next unless /^\s?(typedef\s?)?enum\s?([a-zA-Z_]\w*)?\s?\{(.*)\}\s?([a-zA-Z_]\w*)?\s?;/;
 	    (my $enum_subs = $3) =~ s/\s//g;
 	    my @enum_subs = split(/,/, $enum_subs);
 	    my $enum_val = -1;
@@ -351,7 +338,7 @@ sub expr {
 	# Eliminate typedefs
 	/\(([\w\s]+)[\*\s]*\)\s*[\w\(]/ && do {
 	    foreach (split /\s+/, $1) {  # Make sure all the words are types,
-		last unless ($isatype{$_} or $_ eq 'struct');
+		last unless ($isatype{$_} or $_ eq 'struct' or $_ eq 'union');
 	    }
 	    s/\([\w\s]+[\*\s]*\)// && next;      # then eliminate them.
 	};
@@ -374,7 +361,7 @@ sub expr {
 	};
 	s/^([_a-zA-Z]\w*)//	&& do {
 	    my $id = $1;
-	    if ($id eq 'struct') {
+	    if ($id eq 'struct' || $id eq 'union') {
 		s/^\s+(\w+)//;
 		$id .= ' ' . $1;
 		$isatype{$id} = 1;
@@ -387,8 +374,8 @@ sub expr {
 		$new .= '->' if /^[\[\{]/;
 	    } elsif ($id eq 'defined') {
 		$new .= 'defined';
-	    } elsif (/^\(/) {
-		s/^\((\w),/("$1",/ if $id =~ /^_IO[WR]*$/i;	# cheat
+	    } elsif (/^\s*\(/) {
+		s/^\s*\((\w),/("$1",/ if $id =~ /^_IO[WR]*$/i;	# cheat
 		$new .= " &$id";
 	    } elsif ($isatype{$id}) {
 		if ($new =~ /{\s*$/) {
@@ -415,6 +402,66 @@ sub expr {
 }
 
 
+sub next_line
+{
+    my ($in, $out);
+    my $pre_sub_tri_graphs = 1;
+
+    READ: while (not eof IN) {
+        $in  .= <IN>;
+        chomp $in;
+        next unless length $in;
+
+        while (length $in) {
+            if ($pre_sub_tri_graphs) {
+                # Preprocess all tri-graphs 
+                # including things stuck in quoted string constants.
+                $in =~ s/\?\?=/#/g;                         # | ??=|  #|
+                $in =~ s/\?\?\!/|/g;                        # | ??!|  ||
+                $in =~ s/\?\?'/^/g;                         # | ??'|  ^|
+                $in =~ s/\?\?\(/[/g;                        # | ??(|  [|
+                $in =~ s/\?\?\)/]/g;                        # | ??)|  ]|
+                $in =~ s/\?\?\-/~/g;                        # | ??-|  ~|
+                $in =~ s/\?\?\//\\/g;                       # | ??/|  \|
+                $in =~ s/\?\?</{/g;                         # | ??<|  {|
+                $in =~ s/\?\?>/}/g;                         # | ??>|  }|
+            }
+            if ($in =~ s/\\$//) {                           # \-newline
+                $out    .= ' ';
+                next READ;
+            } elsif ($in =~ s/^([^"'\\\/]+)//) {            # Passthrough
+                $out    .= $1;
+            } elsif ($in =~ s/^(\\.)//) {                   # \...
+                $out    .= $1;
+            } elsif ($in =~ s/^('(\\.|[^'\\])*')//) {       # '...
+                $out    .= $1;
+            } elsif ($in =~ s/^("(\\.|[^"\\])*")//) {       # "...
+                $out    .= $1;
+            } elsif ($in =~ s/^\/\/.*//) {                  # //...
+                # fall through
+            } elsif ($in =~ m/^\/\*/) {                     # /*...
+                # C comment removal adapted from perlfaq6:
+                if ($in =~ s/^\/\*[^*]*\*+([^\/*][^*]*\*+)*\///) {
+                    $out    .= ' ';
+                } else {                                    # Incomplete /* */
+                    next READ;
+                }
+            } elsif ($in =~ s/^(\/)//) {                    # /...
+                $out    .= $1;
+            } elsif ($in =~ s/^([^\'\"\\\/]+)//) {
+                $out    .= $1;
+            } else {
+                die "Cannot parse:\n$in\n";
+            }
+        }
+
+        last READ if $out =~ /\S/;
+    }
+
+    return $out;
+}
+
+
 # Handle recursive subdirectories without getting a grotesquely big stack.
 # Could this be implemented using File::Find?
 sub next_file
@@ -563,9 +610,9 @@ sub build_preamble_if_necessary
                 print PREAMBLE "# $_=$define{$_}\n";
             }
 
-            if ($define{$_} =~ /^\d+$/) {
+            if ($define{$_} =~ /^(\d+)U?L{0,2}$/i) {
                 print PREAMBLE
-                    "unless (defined &$_) { sub $_() { $define{$_} } }\n\n";
+                    "unless (defined &$_) { sub $_() { $1 } }\n\n";
             } elsif ($define{$_} =~ /^\w+$/) {
                 print PREAMBLE
                     "unless (defined &$_) { sub $_() { &$define{$_} } }\n\n";