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