mirror of
https://github.com/curl/curl
synced 2026-08-25 12:32:35 -04:00
1ea07d6e0a
The filter only leaves comments and strings in all files using .c or .h extensions. It is important that the filter runs after all the other checks are done on these files as this process destroys the files. Fixes #22508 Closes #22509
191 lines
4.6 KiB
Perl
Executable file
191 lines
4.6 KiB
Perl
Executable file
#!/usr/bin/env perl
|
|
# Copyright (C) Daniel Stenberg, <daniel@haxx.se>, et al.
|
|
#
|
|
# SPDX-License-Identifier: curl
|
|
|
|
# Output all the C comments and double-quoted strings in the given source
|
|
# files. All other contents should be blanked out. Output the text at the same
|
|
# horizontal position as in the original file.
|
|
#
|
|
# Ignores strings for the preprocessor.
|
|
#
|
|
## States
|
|
#
|
|
# 0 - default, initial state
|
|
# 1 - there was a slash
|
|
# 2 - quoted string
|
|
# 3 - // comment
|
|
# 4 - /* comment
|
|
# 5 - asterisk found within a /* comment
|
|
# 6 - #include line
|
|
# 7 - backslash in a string
|
|
# 8 - backslash in plain code
|
|
# 9 - single quote in plain code
|
|
#
|
|
## Flags
|
|
#
|
|
# 1 - include preprocessor line, ignore strings
|
|
|
|
sub scanline {
|
|
my ($col, $state, $flags, $l) = @_;
|
|
my $line;
|
|
|
|
if($state == 3) {
|
|
# // ended on the prev line, go back to init
|
|
$state = 0;
|
|
}
|
|
|
|
if(($state == 0) && ($l =~ /^ *\# *include/)) {
|
|
# preprocessor include line
|
|
$flags |= 1;
|
|
}
|
|
else {
|
|
# not preprocessor
|
|
$flags &= ~1;
|
|
}
|
|
|
|
my @c = split(//, $l);
|
|
|
|
# state machine this line
|
|
for my $c (@c) {
|
|
if($state == 1) {
|
|
# we had a slash
|
|
if($c eq "/") {
|
|
# // confirmed, the rest of the line is a comment
|
|
$line .= "//";
|
|
$state = 3;
|
|
}
|
|
elsif($c eq "*") {
|
|
# /* confirmed
|
|
$state = 4;
|
|
$line .= "/*";
|
|
}
|
|
else {
|
|
# back to normal
|
|
$line .= " ";
|
|
$state = 0;
|
|
}
|
|
}
|
|
elsif($state == 2) {
|
|
# a string
|
|
if($c eq "\\") {
|
|
$line .= "\\";
|
|
$state = 7;
|
|
}
|
|
elsif($c eq "\"") {
|
|
# end of the string
|
|
$line .= "\"";
|
|
$state = 0;
|
|
}
|
|
else {
|
|
$line .= $c;
|
|
}
|
|
}
|
|
elsif($state == 3) {
|
|
# a // comment
|
|
$line .= $c;
|
|
}
|
|
elsif($state == 4) {
|
|
# an ongoing /* comment
|
|
if($c eq "*") {
|
|
# could a comment close
|
|
$state = 5;
|
|
}
|
|
else {
|
|
$line .= $c;
|
|
}
|
|
}
|
|
elsif($state == 5) {
|
|
if($c eq "/") {
|
|
# a /* */ comment ended here */
|
|
$line .= "*/";
|
|
$state = 0;
|
|
}
|
|
else {
|
|
# the /* comment continues
|
|
$line .= "*$c";
|
|
$state = 4;
|
|
}
|
|
}
|
|
elsif($state == 7) {
|
|
# the prev was a backslash in a string
|
|
$line .= $c;
|
|
# switch back to normal string
|
|
$state = 2;
|
|
}
|
|
elsif($state == 8) {
|
|
# the prev was a backslash in code
|
|
if($c eq "\n") {
|
|
$line .= $c;
|
|
}
|
|
else {
|
|
#$line .= " ";
|
|
}
|
|
# switch back to plain code
|
|
$state = 0;
|
|
}
|
|
elsif($state == 9) {
|
|
# the prev was a single quote in code
|
|
if($c eq "\n") {
|
|
$line .= $c;
|
|
# switch back to plain code
|
|
$state = 0;
|
|
}
|
|
elsif($c eq "\\") {
|
|
# a backslash followed the quote
|
|
$line .= " ";
|
|
$state = 8;
|
|
}
|
|
else {
|
|
# switch back to plain code
|
|
$state = 0;
|
|
}
|
|
}
|
|
else {
|
|
if($c eq "\\") {
|
|
# got a backslash
|
|
$line .= " ";
|
|
$state = 8
|
|
}
|
|
elsif($c eq "\'") {
|
|
# got a single quote
|
|
$line .= " ";
|
|
$state = 9
|
|
}
|
|
if($c eq "/") {
|
|
$state = 1; # got a slash
|
|
}
|
|
elsif(($c eq "\"") && !($flags & 1)) {
|
|
# start of a string, not within a preprocessor line
|
|
$line .= "\"";
|
|
$state = 2;
|
|
}
|
|
elsif($c eq "\n") {
|
|
$line .= "\n";
|
|
}
|
|
else {
|
|
$line .= " ";
|
|
}
|
|
}
|
|
}
|
|
# strip trailing space
|
|
$line =~ s/( +)\n/\n/;
|
|
return $state, $flags, $line;
|
|
}
|
|
|
|
sub strip {
|
|
my ($f) = @_;
|
|
my $state = 0;
|
|
my $flags = 0;
|
|
open(F, "<$f") || die "can't open $f";
|
|
while(<F>) {
|
|
my $l = $_;
|
|
($state, $flags, $line) = scanline(0, $state, $flags, $l);
|
|
print "$line";
|
|
}
|
|
close(F);
|
|
}
|
|
|
|
for my $f (@ARGV) {
|
|
strip($f);
|
|
}
|