1#!/usr/bin/env perl
2#
3# Clean up include guards in headers
4#
5# Copyright (C) 2016 Red Hat, Inc.
6#
7# Authors:
8#  Markus Armbruster <armbru@redhat.com>
9#
10# This work is licensed under the terms of the GNU GPL, version 2 or
11# (at your option) any later version. See the COPYING file in the
12# top-level directory.
13#
14# Usage: scripts/clean-header-guards.pl [OPTION]... [FILE]...
15#     -c CC     Use a compiler other than cc
16#     -n        Suppress actual cleanup
17#     -v        Show which files are cleaned up, and which are skipped
18#
19# Does the following:
20# - Header files without a recognizable header guard are skipped.
21# - Clean up any untidy header guards in-place.  Warn if the cleanup
22#   renames guard symbols, and explain how to find occurrences of these
23#   symbols that may have to be updated manually.
24# - Warn about duplicate header guard symbols.  To make full use of
25#   this warning, you should clean up *all* headers in one run.
26# - Warn when preprocessing a header with its guard symbol defined
27#   produces anything but whitespace.  The preprocessor is run like
28#   "cc -E -DGUARD_H -c -P -", and fed the test program on stdin.
29
30use strict;
31use warnings;
32use Getopt::Std;
33
34# Stuff we don't want to clean because we import it into our tree:
35my $exclude = qr,^(include/standard-headers/|linux-headers/
36    |pc-bios/|tests/tcg/|tests/multiboot/),x;
37# Stuff that is expected to fail the preprocessing test:
38my $exclude_cpp = qr,^include/libdecnumber/decNumberLocal.h,;
39
40my %guarded = ();
41my %old_guard = ();
42
43our $opt_c = "cc";
44our $opt_n = 0;
45our $opt_v = 0;
46getopts("c:nv");
47
48sub skipping {
49    my ($fname, $msg, $line1, $line2) = @_;
50
51    return if !$opt_v or $fname =~ $exclude;
52    print "$fname skipped: $msg\n";
53    print "    $line1" if defined $line1;
54    print "    $line2" if defined $line2;
55}
56
57sub gripe {
58    my ($fname, $msg) = @_;
59    return if $fname =~ $exclude;
60    print STDERR "$fname: warning: $msg\n";
61}
62
63sub slurp {
64    my ($fname) = @_;
65    local $/;                   # slurp
66    open(my $in, "<", $fname)
67        or die "can't open $fname for reading: $!";
68    return <$in>;
69}
70
71sub unslurp {
72    my ($fname, $contents) = @_;
73    open (my $out, ">", $fname)
74        or die "can't open $fname for writing: $!";
75    print $out $contents
76        or die "error writing $fname: $!";
77    close $out
78        or die "error writing $fname: $!";
79}
80
81sub fname2guard {
82    my ($fname) = @_;
83    $fname =~ tr/a-z/A-Z/;
84    $fname =~ tr/A-Z0-9/_/cs;
85    return $fname;
86}
87
88sub preprocess {
89    my ($fname, $guard) = @_;
90
91    open(my $pipe, "-|", "$opt_c -E -D$guard -c -P - <$fname")
92        or die "can't run $opt_c: $!";
93    while (<$pipe>) {
94        if ($_ =~ /\S/) {
95            gripe($fname, "not blank after preprocessing");
96            last;
97        }
98    }
99    close $pipe
100        or gripe($fname, "preprocessing failed ($opt_c exit status $?)");
101}
102
103for my $fname (@ARGV) {
104    my $text = slurp($fname);
105
106    $text =~ m,\A(\s*\n|\s*//\N*\n|\s*/\*.*?\*/\s*\n)*|,sg;
107    my $pre = $&;
108    unless ($text =~ /\G(.*\n)/g) {
109        $text =~ /\G.*/;
110        skipping($fname, "no recognizable header guard", "$&\n");
111        next;
112    }
113    my $line1 = $1;
114    unless ($text =~ /\G(.*\n)/g) {
115        $text =~ /\G.*/;
116        skipping($fname, "no recognizable header guard", "$&\n");
117        next;
118    }
119    my $line2 = $1;
120    my $body = substr($text, pos($text));
121
122    unless ($line1 =~ /^\s*\#\s*(if\s*\!\s*defined(\s*\()?|ifndef)\s*
123                       ([A-Za-z0-9_]+)/x) {
124        skipping($fname, "no recognizable header guard", $line1, $line2);
125        next;
126    }
127    my $guard = $3;
128    unless ($line2 =~ /^\s*\#\s*define\s+([A-Za-z0-9_]+)/) {
129        skipping($fname, "no recognizable header guard", $line1, $line2);
130        next;
131    }
132    my $guard2 = $1;
133    unless ($guard2 eq $guard) {
134        skipping($fname, "mismatched header guard ($guard vs. $guard2) ",
135                 $line1, $line2);
136        next;
137    }
138
139    unless ($body =~ m,\A((.*\n)*)
140                       ([ \t]*\#[ \t]*endif([ \t]*\N*)\n)
141                       ((?s)(\s*\n|\s*//\N*\n|\s*/\*.*?\*/\s*\n)*)
142                       \Z,x) {
143        skipping($fname, "can't find end of header guard");
144        next;
145    }
146    $body = $1;
147    my $line3 = $3;
148    my $endif_comment = $4;
149    my $post = $5;
150
151    my $oldg = $guard;
152
153    unless ($fname =~ $exclude) {
154        my @issues = ();
155        $guard =~ tr/a-z/A-Z/
156            and push @issues, "contains lowercase letters";
157        $guard =~ s/^_+//
158            and push @issues, "is a reserved identifier";
159        $guard =~ s/(_H)?_*$/_H/
160            and $& ne "_H" and push @issues, "doesn't end with _H";
161        unless ($guard =~ /^[A-Z][A-Z0-9_]*_H/) {
162            skipping($fname, "can't clean up odd guard symbol $oldg\n",
163                     $line1, $line2);
164            next;
165        }
166
167        my $exp = fname2guard($fname =~ s,.*/,,r);
168        unless ($guard =~ /\Q$exp\E\Z/) {
169            $guard = fname2guard($fname =~ s,^include/,,r);
170            push @issues, "doesn't match the file name";
171        }
172        if (@issues and $opt_v) {
173            print "$fname guard $oldg needs cleanup:\n    ",
174                join(", ", @issues), "\n";
175        }
176    }
177
178    $old_guard{$guard} = $oldg
179        if $guard ne $oldg;
180
181    if (exists $guarded{$guard}) {
182        gripe($fname, "guard $guard also used by $guarded{$guard}");
183    } else {
184        $guarded{$guard} = $fname;
185    }
186
187    unless ($fname =~ $exclude) {
188        my $newl1 = "#ifndef $guard\n";
189        my $newl2 = "#define $guard\n";
190        my $newl3 = "#endif\n";
191        $newl3 =~ s,\Z, /* $guard */, if $endif_comment;
192        if ($line1 ne $newl1 or $line2 ne $newl2 or $line3 ne $newl3) {
193            $pre =~ s/\n*\Z/\n\n/ if $pre =~ /\N/;
194            $body =~ s/\A\n*/\n/;
195            if ($opt_n) {
196                print "$fname would be cleaned up\n" if $opt_v;
197            } else {
198                unslurp($fname, "$pre$newl1$newl2$body$newl3$post");
199                print "$fname cleaned up\n" if $opt_v;
200            }
201        }
202    }
203
204    preprocess($fname, $opt_n ? $oldg : $guard)
205        unless $fname =~ $exclude or $fname =~ $exclude_cpp;
206}
207
208if (%old_guard) {
209    print STDERR "warning: guard symbol renaming may break things\n";
210    for my $guard (sort keys %old_guard) {
211        print STDERR "    $old_guard{$guard} -> $guard\n";
212    }
213    print STDERR "To find uses that may have to be updated try:\n";
214    print STDERR "    git grep -Ew '", join("|", sort values %old_guard),
215        "'\n";
216}
217