From: Kurt D. Starsinic <kstar@wolfetech.com>
Date: Thu, 19 Apr 2001 01:11:41 +0000 (-0400)
Subject: h2ph test suite bugfix and refactoring
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=79c1b905064b9400e9fab8968bd2c8bffaaa289a;p=p5sagit%2Fp5-mst-13.2.git

h2ph test suite bugfix and refactoring
Message-ID: <20010419011141.A5798@cpan.org>

p4raw-id: //depot/perl@9753
---

diff --git a/t/lib/h2ph.h b/t/lib/h2ph.h
index cddf0a7..128ec5f 100644
--- a/t/lib/h2ph.h
+++ b/t/lib/h2ph.h
@@ -38,7 +38,7 @@
 #if !(defined __SOMETHING_MORE_IMPORTANT)
 #    warn Be careful...
 #elif !(defined __SOMETHING_REALLY_REALLY_IMPORTANT)
-#    error Nup, can't go on /* ' /* stupid font-lock-mode */
+#    error "Nup, can't go on" /* ' /* stupid font-lock-mode */
 #else /* defined __SOMETHING_MORE_IMPORTANT && defined __SOMETHING_REALLY_REALLY_IMPORTANT */
 #    define EVERYTHING_IS_OK
 #endif
diff --git a/t/lib/h2ph.pht b/t/lib/h2ph.pht
index e5b2932..e8868dc 100644
--- a/t/lib/h2ph.pht
+++ b/t/lib/h2ph.pht
@@ -29,7 +29,7 @@ unless(defined(&_H2PH_H_)) {
     if(!(defined (defined(&__SOMETHING_MORE_IMPORTANT) ? &__SOMETHING_MORE_IMPORTANT : 0))) {
     }
  elsif(!(defined (defined(&__SOMETHING_REALLY_REALLY_IMPORTANT) ? &__SOMETHING_REALLY_REALLY_IMPORTANT : 0))) {
-	die("Nup\,\ can\'t\ go\ on\ ");
+	die("Nup, can't go on");
     } else {
 	eval 'sub EVERYTHING_IS_OK () {1;}' unless defined(&EVERYTHING_IS_OK);
     }
diff --git a/utils/h2ph.PL b/utils/h2ph.PL
index 855a899..ab6cad9 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;
@@ -415,6 +398,52 @@ sub expr {
 }
 
 
+sub next_line
+{
+    my ($in, $out);
+
+    READ: while (not eof IN) {
+        $in  .= <IN>;
+        chomp $in;
+        next unless length $in;
+
+        while (length $in) {
+            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/^\/\/.*//) {                  # //...
+                last READ;
+            } 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;
+    }
+
+    return $out;
+}
+
+
 # Handle recursive subdirectories without getting a grotesquely big stack.
 # Could this be implemented using File::Find?
 sub next_file