t/codingstd/linelength.t

   1 #! perl
   2 # Copyright (C) 2006-2009, Parrot Foundation.
   3 # $Id$
   4
   5 =head1 NAME
   6
   7 t/codingstd/linelength.t - Test code lines length
   8
   9 =head1 SYNOPSIS
  10
  11     # test all files
  12     % prove t/codingstd/linelength.t
  13
  14     # test specific files
  15     % perl t/codingstd/linelength.t src/foo.c include/parrot/bar.h
  16
  17 =head1 DESCRIPTION
  18
  19 Tests source files for the line length limit as defined in
  20 F<pdd07_codingstd.pod>.  Only files for some language implementations are
  21 checked.
  22
  23 =head1 SEE ALSO
  24
  25 L<docs/pdds/pdd07_codingstd.pod>
  26
  27 =cut
  28
  29 use strict;
  30 use warnings;
  31 use lib qw( . lib ../lib ../../lib );
  32
  33 use File::Spec;
  34 use Test::More tests => 1;
  35 use ExtUtils::Manifest qw( maniread );
  36
  37 use Parrot::Config qw/ %PConfig /;
  38
  39 my $num_col_limit = 100;
  40
  41 my $build_dir = $PConfig{build_dir};
  42 my $manifest = maniread( File::Spec->catfile( $build_dir, 'MANIFEST' ) );
  43
  44 # skip files listed in the __DATA__ section
  45 my %skip_files;
  46 while (<DATA>) {
  47     next if m{^#};
  48     next if m{^\s*$};
  49     chomp;
  50     $skip_files{$_}++;
  51 }
  52
  53 # find the files that we need to check
  54 my @files = @ARGV ? <@ARGV> : source_files();
  55
  56 # check all the files and keep a list of those failing
  57 my @lines_too_long;
  58 foreach (@files) {
  59     my $lineinfo = info_for_first_long_line($_);
  60     next unless $lineinfo;
  61     push @lines_too_long => $lineinfo;
  62 }
  63
  64 ## L<PDD07/Code Formatting/"Source line length is limited to 100 characters">
  65 ok( !@lines_too_long, 'Line length ok' )
  66     or diag( "Lines longer than coding standard limit ($num_col_limit columns) in "
  67         . scalar @lines_too_long
  68         . " files:\n"
  69         . join( "\n", @lines_too_long ) );
  70
  71 sub info_for_first_long_line {
  72     my $file = shift;
  73
  74     open my $fh, '<', $file or die "Can't open file '$file'";
  75     while ( my $line = <$fh> ) {
  76         chomp $line;
  77         $line =~ s/\t/' ' x (1 + length($`) % 8)/eg;  # expand \t
  78         next if $line =~ m/https?:\/\//;              # skip long web addresses
  79         next if $line =~ m/\$Id:/;
  80         next if $line =~ m/CONST_STRING\(/;
  81
  82         return sprintf '%s:%d: %d cols', $file, $., length($line)
  83             if length($line) > $num_col_limit;
  84     }
  85     return;
  86 }
  87
  88 sub source_files {
  89     my @files;
  90     foreach my $file ( sort keys(%$manifest) ) {
  91         my $full_path = File::Spec->catfile( $build_dir, $file );
  92
  93         # skip files specified in __DATA__ section
  94         next if exists $skip_files{$file};
  95
  96         push @files => $full_path
  97             if $file =~ m{\.(c|pmc|ops|pod)$};
  98     }
  99     return @files;
 100 }
 101
 102 # Local Variables:
 103 #   mode: cperl
 104 #   cperl-indent-level: 4
 105 #   fill-column: 100
 106 # End:
 107 # vim: expandtab shiftwidth=4:
 108
 109 __DATA__
 110 # Lex and Bison generated
 111 compilers/imcc/imclexer.c
 112 compilers/imcc/imcparser.c
 113 compilers/pirc/src/main.c
 114 compilers/pirc/src/pirlexer.c
 115 compilers/pirc/src/pirlexer.h
 116 compilers/pirc/src/pirparser.c
 117 compilers/pirc/src/pircompunit.h
 118 compilers/pirc/src/pircompunit.c
 119 compilers/pirc/src/pasm.l
 120 compilers/pirc/src/pasm.y
 121 compilers/pirc/macro/macro.h
 122 compilers/pirc/macro/macrolexer.c
 123 compilers/pirc/macro/macrolexer.h
 124 compilers/pirc/macro/macroparser.c
 125 compilers/pirc/macro/macroparser.h
 126 compilers/pirc/src/hdocprep.l
 127 compilers/pirc/src/hdocprep.c
 128 # generated files
 129 src/ops/core_ops.c
 130 # generated by tools/dev/nci_thunk_gen.pir
 131 src/nci/core_thunks.c
 132 src/nci/extra_thunks.c
 133 # these ones include long POD
 134 docs/embed.pod