c_indent.t

#! perl
# Copyright (C) 2006-2009, 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 $indent = q{  } x ( @{ $state{stack} } - 1 );
                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 $indent = q{  } x ( @{ $state{stack} } - 1 );
                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: