Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
tree: 7847e55203
Fetching contributors…

Cannot retrieve contributors at this time

363 lines (290 sloc) 9.769 kB
#! perl
# Copyright (C) 2009-2012, Parrot Foundation.
use strict;
use warnings;
use Cwd qw(abs_path getcwd realpath);
use Fatal qw(open);
use File::Find;
use File::Spec;
use Test::More;
use lib qw( lib );
use Parrot::Config;
=head1 NAME
t/src/checkdepend.t
=head1 DESCRIPTION
A script to check that every file has makefile deps on its includes.
checkdepend.pl [--dump]
If called with C<--dump>, no tests are run, and the pre-processed makefile
is dumped (in lieu of having C<cc>'s C<-E> for C<make>. This option is only
intended to be used by developers examining the build process.
The test's output shows the extra dependencies recorded for "got", and the
missing dependencies for "expected" - any dependencies that match up exactly
are not reported on. The number in parentheses indicates how many were found.
(Useful for identifying when a requirement is included multiple times.)
=head1 REQUIREMENTS
A built parrot (Configure and make) to generate all files so we can analyze
them. (That's why it's in t/src/ instead of t/codingstd)
=head1 BUGS
See L<http://trac.parrot.org/parrot/wiki/BuildTaskList>. Only checks C<.c>
and C<.h> files at the moment.
=cut
if (! -e 'Makefile') {
plan(skip_all =>
'no Makefile found; This test requires a full build for analysis.');
exit;
}
my @incfiles = [];
find( { wanted => \&wanted, no_chdir => 1 },
qw/src compilers include frontend/ );
our %deps;
foreach my $file (sort grep /\.[hc]$/, @incfiles) {
# skip pmcs - we don't handle inheritance correctly
next if $file =~ m{^src/(?:dyn)?pmc/};
next if ($file eq 'src/nci/core_thunks.c' and
! defined $Parrot::Config::PConfig{PARROT_HAS_CORE_NCI_THUNKS});
next if ($file eq 'src/nci/extra_thunks.c' and
! defined $Parrot::Config::PConfig{PARROT_HAS_EXTRA_NCI_THUNKS});
open my $fh, '<', $file;
my $guts;
{
local $/;
$guts = <$fh>;
}
# Ignore anything inside a c-style comment.
$guts =~ s{\Q/*\E.*?\Q*/}{}gm;
my @includes = $guts =~ m/# *include "(.*)"/g;
# Canonicalize each of these includes.
$deps{$file} = [ ];
foreach my $include (@includes) {
my $found;
my @include_dirs;
push @include_dirs, (File::Spec->splitpath($file))[1];
push @include_dirs, 'include';
push @include_dirs, 'include/pmc';
for my $path (@include_dirs) {
next if $found;
my $make_dep = File::Spec->catfile($path, $include);
if (defined($make_dep) && -f $make_dep) {
$make_dep = collapse_path($make_dep);
push @{$deps{$file}}, $make_dep;
$found = 1;
}
}
# skip bogus warnings
if (!$found
and ($file ne 'src/gc/malloc.c' or $include ne '/usr/include/malloc.h'
or defined $Parrot::Config::PConfig{HAVE_USR_INCLUDE_MALLOC_H})
and ($file ne 'src/glut_nci_thunks.c' or $include ne 'glut_nci_thunks.str'))
{
diag "couldn't find $include, included from $file";
}
}
# always require an explicit .o -> .c dep. This is lazy and not always
# needed. However, missing it when it is needed causes pain.
if ($file =~ /\.c$/) {
push @{$deps{$file}}, $file;
}
}
sub get_rules {
my ($filename, $rules) = @_;
open my $mf, '<', "$filename";
my $global_line_num = @$rules;
my $file_line_num = 1;
my $escape_start = 1;
foreach (<$mf>) {
my $line = $_;
chomp $line;
if ($_ =~ /^include\s+(.*)$/m) {
get_rules($1, $rules);
$global_line_num = @$rules;
$file_line_num++;
}
else {
$rules->[$global_line_num] =
{
filename => $filename,
line => $line,
line_num => $file_line_num,
};
# Convert all \-newline continuations into single lines for ease of
# processing. Leave blank lines to keep line numbers accurate.
if (exists $rules->[$escape_start]{line} &&
$rules->[$escape_start]{line} !~ /\\$/ &&
$rules->[$global_line_num]{line} =~ /\\$/) {
$escape_start = $global_line_num;
}
if ($rules->[$escape_start]{line} && $rules->[$escape_start]{line} =~ /\\$/ &&
$escape_start != $global_line_num) {
$rules->[$escape_start]{line} =~ s/\\$//;
$rules->[$escape_start]{line} .= $rules->[$global_line_num]{line};
$rules->[$global_line_num]{line} = '';
}
$file_line_num++;
$global_line_num++;
}
}
close $mf;
}
our $rules = [];
get_rules('Makefile', $rules);
#expand all variables
our %vars;
foreach (@$rules) {
#expand any known variables
while ($_->{line} =~ /\$\(([A-Z_]+)\)/) {
my $var_name = $1;
if (exists $vars{$var_name}) {
$_->{line} =~ s/\$\($var_name\)/$vars{$var_name}/g;
}
else {
$_->{line} =~ s/\$\($var_name\)//g;
}
}
#store any new definitions
if ($_->{line} =~ /^(\w+)\s+=\s+(.*)$/) {
$vars{$1} = $2;
}
}
if (@ARGV && $ARGV[0] eq '--dump') {
print "$_->{line}\n" for (@$rules);
exit 0;
}
my $test_count = grep {/\.(c)$/} (keys %deps);
plan( tests => $test_count );
#foreach my $header (sort grep {/\.h$/} (keys %deps)) {
# # static headers shouldn't depend on anything else.
# if ($rules =~ /^$header\s*:\s*(.*)\s*$/m) {
# #is("", $1, "$header should have no dependencies");
# }
#}
my @files = keys %deps;
@files = @ARGV if @ARGV;
check_files($rules, \@files, '.c', $vars{O});
sub check_files {
my ($rules, $possible_files, $src_ext, $obj_ext) = @_;
foreach my $file (sort grep {/$src_ext$/} @$possible_files) {
my ($active_makefile, $active_line_num);
my $rule = $file;
$rule =~ s/$src_ext$//;
#find the applicable rule for this file
my $rule_deps = '';
for (@$rules) {
if ($_->{line} =~ /^$rule$obj_ext\s*:\s*(.*)\s*$/) {
$rule_deps = $1;
$active_makefile = $_->{filename};
$active_line_num = $_->{line_num};
}
last if $rule_deps;
}
my $extra_info = "(no rule found for this file)";
if ($rule_deps) {
$extra_info = "($active_makefile: line $active_line_num)";
}
my @rule_deps = split /\s+/, $rule_deps;
my @expected_deps = (get_deps($file));
is_list_same(\@rule_deps, \@expected_deps, "$file $extra_info.");
}
}
sub collapse_path {
my $path = shift;
return $path unless defined $path;
my $cwd = getcwd();
# With a symlinked builddir need to collapse x/../y sections into y.
# It is safe with our directory structure
if ( -l $path ) {
my $up = File::Spec->updir();
my $upsep = File::Spec->catfile($up, '');
if (index($path, $upsep) > -1) {
my ($vol,$dir,$fname) = File::Spec->splitpath($path);
my @dirs = File::Spec->splitdir($dir);
my @newdirs;
while (@dirs) {
my $d = shift @dirs;
if ($d eq $up) {
warn unless @newdirs;
pop @newdirs;
}
else {
push @newdirs, $d;
}
}
my $newpath = File::Spec->catfile
($vol ? ($vol, File::Spec->catdir(@newdirs), $fname)
: (File::Spec->catdir(@newdirs), $fname));
return $newpath;
}
return File::Spec->abs2rel( $path, $cwd ) ;
}
my $abspath = abs_path($path);
return $path unless defined $abspath;
$abspath =~ s/^\Q$cwd\E\///;
return $abspath;
}
sub get_deps {
my $file = shift;
my %all_deps;
if (! exists $deps{$file}) {
return;
}
# add explicit deps
my @pending_deps = @{$deps{$file}};
while (@pending_deps) {
my $dep = shift @pending_deps;
if (!exists $all_deps{$dep}) {
$all_deps{$dep} = 1;
if (exists $deps{$dep}) {
push @pending_deps, @{$deps{$dep}};
}
}
}
return keys %all_deps;
}
# I'd rather use Test::Differences, but this lets us skip a dependency.
sub is_list_same {
my $got = shift;
my $exp = shift;
my $test = shift;
# keep track of the number of times something appears to
# avoid redundant includes)
my(%got, %exp);
for my $file (@$got) { $got{$file}++ };
for my $file (@$exp) { $exp{$file}++ };
# Remove any elements found in both
my @gots = keys %got;
foreach my $file (@gots) {
if (exists $exp{$file}) {
if ($exp{$file} == $got{$file}) {
delete $got{$file};
delete $exp{$file};
}
}
}
my $extras = scalar(keys %got);
my $missing = scalar(keys %exp);
if ($extras == 0 && $missing == 0) {
pass($test);
return;
}
my $got_msg = "";
for my $file (keys %got) {
$got_msg .= "$file($got{$file})\n";
}
my $exp_msg = "";
for my $file (keys %exp) {
$exp_msg .= "$file($exp{$file})\n";
}
local $Test::Builder::Level = $Test::Builder::Level + 1;
is ($got_msg, $exp_msg, $test);
return;
}
sub wanted {
if ($File::Find::name =~ /\.(c|h)$/) {
push @incfiles, $File::Find::name;
}
}
# Local Variables:
# mode: cperl
# cperl-indent-level: 4
# fill-column: 100
# End:
# vim: expandtab shiftwidth=4:
Jump to Line
Something went wrong with that request. Please try again.