diff options
| author | Kurt D. Starsinic <kstar@wolfetech.com> | 2001-04-18 21:11:41 -0400 |
|---|---|---|
| committer | Jarkko Hietaniemi <jhi@iki.fi> | 2001-04-19 04:21:52 +0000 |
| commit | 79c1b905064b9400e9fab8968bd2c8bffaaa289a (patch) | |
| tree | 2b4fc97b59d4a29d2d087bf8864bce955ee0fd8b | |
| parent | f120891071b92048ee3b9c8c45de09079fba6cba (diff) | |
| download | perl-79c1b905064b9400e9fab8968bd2c8bffaaa289a.tar.gz | |
h2ph test suite bugfix and refactoring
Message-ID: <20010419011141.A5798@cpan.org>
p4raw-id: //depot/perl@9753
| -rw-r--r-- | t/lib/h2ph.h | 2 | ||||
| -rw-r--r-- | t/lib/h2ph.pht | 2 | ||||
| -rw-r--r-- | utils/h2ph.PL | 65 |
3 files changed, 49 insertions, 20 deletions
diff --git a/t/lib/h2ph.h b/t/lib/h2ph.h index cddf0a7d94..128ec5f1ae 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 e5b293243e..e8868dcb4a 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 855a899499..ab6cad9560 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 |