| lh | 9ed821d | 2023-04-07 01:36:19 -0700 | [diff] [blame] | 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, | 
 | 22 | 	"I=s"	=> \@opt_include, | 
 | 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 | 	} | 
 | 83 | 	return; | 
 | 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 | } |