]>
Commit | Line | Data |
---|---|---|
179efcb4 VN |
1 | #! /usr/bin/perl |
2 | # | |
3 | # Detect cycles in the header file dependency graph | |
4 | # Vegard Nossum <vegardno@ifi.uio.no> | |
5 | # | |
6 | ||
7 | use strict; | |
8 | use warnings; | |
9 | ||
10 | use Getopt::Long; | |
11 | ||
12 | my $opt_all; | |
13 | my @opt_include; | |
14 | my $opt_graph; | |
15 | ||
16 | &Getopt::Long::Configure(qw(bundling pass_through)); | |
17 | &GetOptions( | |
18 | help => \&help, | |
19 | version => \&version, | |
20 | ||
21 | all => \$opt_all, | |
79ff807c | 22 | "I=s" => \@opt_include, |
179efcb4 VN |
23 | graph => \$opt_graph, |
24 | ); | |
25 | ||
26 | push @opt_include, 'include'; | |
27 | my %deps = (); | |
28 | my %linenos = (); | |
29 | ||
30 | my @headers = grep { strip($_) } @ARGV; | |
31 | ||
32 | parse_all(@headers); | |
33 | ||
34 | if($opt_graph) { | |
35 | graph(); | |
36 | } else { | |
37 | detect_cycles(@headers); | |
38 | } | |
39 | ||
40 | ||
41 | sub help { | |
42 | print "Usage: $0 [options] file...\n"; | |
43 | print "\n"; | |
44 | print "Options:\n"; | |
45 | print " --all\n"; | |
46 | print " --graph\n"; | |
47 | print "\n"; | |
48 | print " -I includedir\n"; | |
49 | print "\n"; | |
50 | print "To make nice graphs, try:\n"; | |
51 | print " $0 --graph include/linux/kernel.h | dot -Tpng -o graph.png\n"; | |
52 | exit; | |
53 | } | |
54 | ||
55 | sub version { | |
56 | print "headerdep version 2\n"; | |
57 | exit; | |
58 | } | |
59 | ||
60 | # Get a file name that is relative to our include paths | |
61 | sub strip { | |
62 | my $filename = shift; | |
63 | ||
64 | for my $i (@opt_include) { | |
65 | my $stripped = $filename; | |
66 | $stripped =~ s/^$i\///; | |
67 | ||
68 | return $stripped if $stripped ne $filename; | |
69 | } | |
70 | ||
71 | return $filename; | |
72 | } | |
73 | ||
74 | # Search for the file name in the list of include paths | |
75 | sub search { | |
76 | my $filename = shift; | |
77 | return $filename if -f $filename; | |
78 | ||
79 | for my $i (@opt_include) { | |
80 | my $path = "$i/$filename"; | |
81 | return $path if -f $path; | |
82 | } | |
1dcd8100 | 83 | return; |
179efcb4 VN |
84 | } |
85 | ||
86 | sub parse_all { | |
87 | # Parse all the headers. | |
88 | my @queue = @_; | |
89 | while(@queue) { | |
90 | my $header = pop @queue; | |
91 | next if exists $deps{$header}; | |
92 | ||
93 | $deps{$header} = [] unless exists $deps{$header}; | |
94 | ||
95 | my $path = search($header); | |
96 | next unless $path; | |
97 | ||
98 | open(my $file, '<', $path) or die($!); | |
99 | chomp(my @lines = <$file>); | |
100 | close($file); | |
101 | ||
102 | for my $i (0 .. $#lines) { | |
103 | my $line = $lines[$i]; | |
104 | if(my($dep) = ($line =~ m/^#\s*include\s*<(.*?)>/)) { | |
105 | push @queue, $dep; | |
106 | push @{$deps{$header}}, [$i + 1, $dep]; | |
107 | } | |
108 | } | |
109 | } | |
110 | } | |
111 | ||
112 | sub print_cycle { | |
113 | # $cycle[n] includes $cycle[n + 1]; | |
114 | # $cycle[-1] will be the culprit | |
115 | my $cycle = shift; | |
116 | ||
117 | # Adjust the line numbers | |
118 | for my $i (0 .. $#$cycle - 1) { | |
119 | $cycle->[$i]->[0] = $cycle->[$i + 1]->[0]; | |
120 | } | |
121 | $cycle->[-1]->[0] = 0; | |
122 | ||
123 | my $first = shift @$cycle; | |
124 | my $last = pop @$cycle; | |
125 | ||
126 | my $msg = "In file included"; | |
127 | printf "%s from %s,\n", $msg, $last->[1] if defined $last; | |
128 | ||
129 | for my $header (reverse @$cycle) { | |
130 | printf "%s from %s:%d%s\n", | |
131 | " " x length $msg, | |
132 | $header->[1], $header->[0], | |
133 | $header->[1] eq $last->[1] ? ' <-- here' : ''; | |
134 | } | |
135 | ||
136 | printf "%s:%d: warning: recursive header inclusion\n", | |
137 | $first->[1], $first->[0]; | |
138 | } | |
139 | ||
140 | # Find and print the smallest cycle starting in the specified node. | |
141 | sub detect_cycles { | |
142 | my @queue = map { [[0, $_]] } @_; | |
143 | while(@queue) { | |
144 | my $top = pop @queue; | |
145 | my $name = $top->[-1]->[1]; | |
146 | ||
147 | for my $dep (@{$deps{$name}}) { | |
148 | my $chain = [@$top, [$dep->[0], $dep->[1]]]; | |
149 | ||
150 | # If the dep already exists in the chain, we have a | |
151 | # cycle... | |
152 | if(grep { $_->[1] eq $dep->[1] } @$top) { | |
153 | print_cycle($chain); | |
154 | next if $opt_all; | |
155 | return; | |
156 | } | |
157 | ||
158 | push @queue, $chain; | |
159 | } | |
160 | } | |
161 | } | |
162 | ||
163 | sub mangle { | |
164 | $_ = shift; | |
165 | s/\//__/g; | |
166 | s/\./_/g; | |
167 | s/-/_/g; | |
168 | $_; | |
169 | } | |
170 | ||
171 | # Output dependency graph in GraphViz language. | |
172 | sub graph { | |
173 | print "digraph {\n"; | |
174 | ||
175 | print "\t/* vertices */\n"; | |
176 | for my $header (keys %deps) { | |
177 | printf "\t%s [label=\"%s\"];\n", | |
178 | mangle($header), $header; | |
179 | } | |
180 | ||
181 | print "\n"; | |
182 | ||
183 | print "\t/* edges */\n"; | |
184 | for my $header (keys %deps) { | |
185 | for my $dep (@{$deps{$header}}) { | |
186 | printf "\t%s -> %s;\n", | |
187 | mangle($header), mangle($dep->[1]); | |
188 | } | |
189 | } | |
190 | ||
191 | print "}\n"; | |
192 | } |