use 5.006;
use strict;
use warnings;
my %DEPS;
my @CYCLES;
sub find_all_cycles;
while (<>) {
chomp;
my ($module, $dependency_str) = /^\s*([^:]+):\s*(.*)\s*$/;
die "Malformed data: $_" unless defined $dependency_str;
my @dependencies = split(/ /, $dependency_str);
$DEPS{$module} = \@dependencies;
}
find_all_cycles();
my @output;
my $cycles_found = 0;
foreach my $cycle (@CYCLES) {
my @modules = sort keys %{$cycle};
my %dependencies;
foreach my $module (@modules) {
@dependencies{@{$DEPS{$module}}} = 1;
}
foreach my $module (@modules) {
delete $dependencies{$module};
}
my @archives = grep(/\.a$/, @modules);
if (@archives > 1) {
$cycles_found = $cycles_found + 1;
print STDERR "find-cycles.pl: Circular dependency between *.a files:\n";
print STDERR "find-cycles.pl: ", join(' ', @archives), "\n";
push @modules, @archives; } elsif (@modules > 1) {
$cycles_found = $cycles_found + 1;
print STDERR "find-cycles.pl: Circular dependency between *.o files:\n";
print STDERR "find-cycles.pl: ", join(' ', @modules), "\n";
push @modules, @modules; }
push @output, (join(' ', @modules) . ': ' .
join(' ', sort keys %dependencies) . "\n");
}
print sort @output;
exit $cycles_found;
my %SEEN;
my %CYCLES;
sub find_cycles ($@);
sub found_cycles ($@);
sub find_all_cycles {
my @modules = sort keys %DEPS;
foreach my $module (@modules) { find_cycles($module); }
foreach my $module (@modules) {
unless (defined $CYCLES{$module}) {
my %cycle = ($module, 1);
$CYCLES{$module} = \%cycle;
}
}
my %seen;
foreach my $cycle (values %CYCLES) {
unless ($seen{$cycle}) {
$seen{$cycle} = 1;
push @CYCLES, $cycle;
}
}
}
sub find_cycles ($@) {
my ($module, @path) = @_;
if (str_in_list($module, @path)) {
found_cycle($module, @path);
} else {
return if defined $SEEN{$module};
$SEEN{$module} = 1;
foreach my $dep (@{$DEPS{$module}}) {
find_cycles($dep, @path, $module);
}
}
}
sub found_cycle ($@) {
my ($module, @path) = @_;
while ($path[0] ne $module) { shift @path; }
my %cycle;
foreach my $item (@path) {
$cycle{$item} = 1;
if (defined $CYCLES{$item}) {
foreach my $old_item (keys %{$CYCLES{$item}}) {
$cycle{$old_item} = 1;
}
}
}
my $cycle_ref = \%cycle;
foreach my $item (keys %cycle) {
$CYCLES{$item} = $cycle_ref;
}
}
sub str_in_list ($@) {
my ($str, @list) = @_;
foreach my $item (@list) {
return 1 if ($item eq $str);
}
return 0;
}