Skip to content
Find file
Fetching contributors…
Cannot retrieve contributors at this time
259 lines (220 sloc) 8.96 KB
#! perl
# Copyright (C) 2006-2014, Parrot Foundation.
use strict;
use warnings;
use lib qw( . lib ../lib ../../lib );
use Test::More tests => 2;
use Parrot::Distribution;
=head1 NAME
t/codingstd/c_indent.t - checks for rules related to indenting in C source
=head1 SYNOPSIS
# test all files
% prove t/codingstd/c_indent.t
# test specific files
% perl t/codingstd/c_indent.t src/foo.c include/parrot/bar.h
=head1 DESCRIPTION
Checks that all C language source files have the proper use of indentation,
as specified in PDD07.
=head1 SEE ALSO
L<docs/pdds/pdd07_codingstd.pod>
=cut
my @files =
@ARGV
? <@ARGV>
: map { $_->path() } Parrot::Distribution->new()->get_c_language_files();
check_indent(@files);
sub check_indent {
my ( @pp_indent, @c_indent );
my ( %pp_failed, %c_failed );
foreach my $path (@_) {
my @source;
open my $IN, '<', $path
or die "Can not open '$path' for reading!\n";
@source = <$IN>;
my %state = (
stack => [],
line_cnt => 0,
bif => undef,
prev_last_char => '',
last_char => '',
in_comment => 0,
);
foreach my $line (@source) {
$state{line_cnt}++;
chomp $line;
next unless $line;
$state{prev_last_char} = $state{last_char};
$state{last_char} = substr( $line, -1, 1 );
# ignore multi-line comments (except the first line)
$state{in_comment} = 0, next if $state{in_comment} &&
$line =~ m{\*/} &&
$' !~ m{/\*}; #'
next if $state{in_comment};
$state{in_comment} = 1
if $line =~ m{/\*} &&
$' !~ m{\*/}; #'
## preprocessor scan
if ( $line =~ m/^\s*\#(\s*)(ifndef|ifdef|if)\s+(.*)/ )
{
my ($prespace, $condition, $postspace) = ($1,$2,$3);
next if ($line =~ m/PARROT_IN_CORE|_GUARD/);
next if ($line =~ m/__cplusplus/);
my $indent = q{ } x @{ $state{stack} };
if ( $prespace ne $indent ) {
push @pp_indent => "$path:$state{line_cnt}\n"
. " got: $line"
. "expected: #$indent$condition $postspace'\n";
$pp_failed{"$path\n"} = 1;
}
push @{ $state{stack} }, "#$condition $postspace";
$state{bif} = undef;
next;
}
if ( $line =~ m/^\s*\#(\s*)(else|elif)/)
{
my ($prespace, $condition) = ($1,$2);
# stay where we are, but indenting should be
# back even with the opening brace.
my $i = @{ $state{stack} } - 1;
my $indent = $i > 0 ? q{ } x $i : '';
if ( $prespace ne $indent ) {
push @pp_indent => "$path:$state{line_cnt}\n"
. " got: $line"
. "expected: #$indent$condition -- it's inside of "
. ( join ' > ', @{ $state{stack} } ) . "\n";
$pp_failed{"$path\n"} = 1;
}
next;
}
if ( $line =~ m/^\s*\#(\s*)(endif)/)
{
my ($prespace, $condition) = ($1,$2);
my $i = @{ $state{stack} } - 1;
my $indent = $i > 0 ? q{ } x $i : '';
if ( $prespace ne $indent ) {
push @pp_indent => "$path:$state{line_cnt}\n"
. " got: $line"
. "expected: #$indent$condition -- it's inside of "
. ( join ' > ', @{ $state{stack} } ) . "\n";
$pp_failed{"$path\n"} = 1;
}
pop @{ $state{stack} };
next;
}
next unless @{ $state{stack} };
if ( $line =~ m/^\s*\#(\s*)(.*)/)
{
my ($prespace, $condition) = ($1,$2);
next if ($line =~ m/ASSERT_ARGS_/); # autogenerated by headerizer
my $indent = q{ } x (@{ $state{stack} });
if ( $prespace ne $indent ) {
push @pp_indent => "$path:$state{line_cnt}\n"
. " got: $line"
. "expected: #$indent$condition -- it's inside of "
. ( join ' > ', @{ $state{stack} } ) . "\n";
$pp_failed{"$path\n"} = 1;
}
next;
}
## c source scan
# for now just try to catch glaring errors. A real parser is
# probably overkill for this task. For now we just check the
# first line of a function, and assume that more likely than not
# indenting is consistent within a func body.
if ($line =~ /^(\s*).*\{\s*$/) {
my $prespace = $1;
# note the beginning of a block, and its indent depth.
$state{bif} = length($prespace);
next;
}
if ($line =~ /^\s*([\#\}])/) {
my $closing_punc = $1;
# skip the last line of the func or cpp directives.
$state{bif} = undef if ( $closing_punc eq "}" );
next;
}
if ( defined($state{bif}) ) {
# first line of a block
if ( $state{bif} == 0 ) {
# first line of a top-level block (first line of a function,
# in other words)
my ($indent) = $line =~ /^(\s*)/;
if ( length($indent) != 4 ) {
push @c_indent => "$path:$state{line_cnt}\n"
. " apparent non-4 space indenting ("
. length($indent)
. " spaces)\n";
$c_failed{"$path\n"} = 1;
}
}
$state{bif} = undef;
}
my ($indent) = $line =~ /^(\s+)/ or next;
$indent = length($indent);
# Ignore the indentation of the current line if the last
# character of the was anything but a ';'.
#
# The indentation of the previous line is not considered.
# Check sanity by verifying that the indentation of the current line
# is divisible by four, unless it should be outdented by 2.
if ($line =~ m{: (?:\s* /\* .*? \*/)? $}x) {
if ( $indent % 4 != 2 &&
!$state{in_comment} &&
$state{prev_last_char} eq ';'
) {
push @c_indent => "$path:$state{line_cnt}\n"
. " apparent non-2 space outdenting ($indent spaces)\n";
$c_failed{"$path\n"} = 1;
}
}
else {
if ( $indent % 4 &&
!$state{in_comment} &&
$state{prev_last_char} eq ';'
) {
push @c_indent => "$path:$state{line_cnt}\n"
. " apparent non-4 space indenting ($indent space"
. ( $indent == 1 ? '' : 's' ) . ")\n";
$c_failed{"$path\n"} = 1;
}
}
}
}
# get the lists of files failing the test
my @c_failed_files = keys %c_failed;
my @pp_failed_files = keys %pp_failed;
## L<PDD07/Code Formatting/"Preprocessor #directives must be indented two columns per nesting level, with two exceptions: neither PARROT_IN_CORE nor the outermost _GUARD #ifdefs cause the level of indenting to increase">
ok( !scalar(@pp_indent), 'Correctly indented preprocessor directives' )
or diag( "incorrect indenting in preprocessor directive found "
. scalar @pp_indent
. " occurrences in "
. scalar @pp_failed_files
. " files:\n@pp_indent" );
ok( !scalar(@c_indent), 'Correctly indented C files' )
or diag( "incorrect indenting in C file found "
. scalar @c_indent
. " occurrences in "
. scalar @c_failed_files
. " files:\n@c_indent" );
}
# dump_state() may be used to diagnose indentation problems.
# dump_state(\%state, $line);
# Takes a list of two arguments: reference to %state and the current line
# (once it has been chomped).
# Prints pipe-delimited list of important features of current state.
sub dump_state {
my ($state, $line) = @_;
print STDERR (join q{|} => (
$state->{line_cnt},
(defined($state->{bif}) ? $state->{bif} : q{u}),
$state->{in_comment},
(join q{*} => @{ $state->{stack} }),
$line,
) ), "\n";
}
# Local Variables:
# mode: cperl
# cperl-indent-level: 4
# fill-column: 100
# End:
# vim: expandtab shiftwidth=4:
Something went wrong with that request. Please try again.