t/codingstd/c_operator.t

   1 #! perl
   2 # Copyright (C) 2006-2009, Parrot Foundation.
   3 # $Id$
   4
   5 use strict;
   6 use warnings;
   7
   8 use lib qw( . lib ../lib ../../lib );
   9 use Test::More tests => 1;
  10 use Parrot::Distribution;
  11 use Pod::Simple;
  12
  13 =head1 NAME
  14
  15 t/codingstd/c_operator.t - checks spacing around operators in C source
  16
  17 =head1 SYNOPSIS
  18
  19     # test all files
  20     % prove t/codingstd/c_operator.t
  21
  22     # test specific files
  23     % perl t/codingstd/c_operator.t src/foo.c include/parrot/bar.h
  24
  25 =head1 DESCRIPTION
  26
  27 Checks that all C language source files have the proper use of spacing
  28 around operators.
  29
  30 =head1 AUTHOR
  31
  32 Paul Cochrane <paultcochrane at gmail dot com>
  33
  34 =head1 SEE ALSO
  35
  36 L<docs/pdds/pdd07_codingstd.pod>
  37
  38 =cut
  39
  40 my $DIST = Parrot::Distribution->new;
  41 my @files = @ARGV ? <@ARGV> : $DIST->get_c_language_files();
  42 check_operators(@files);
  43
  44 exit;
  45
  46 sub strip_pod {
  47     my $buf = shift;
  48     my $parser = Pod::Simple->new();
  49     my $non_pod_buf;
  50     $parser->output_string( \$non_pod_buf );
  51     # set up a code handler to get at the non-pod
  52     # thanks to Thomas Klausner's Pod::Strip for the inspiration
  53     $parser->code_handler(
  54         sub {
  55             print {$_[2]{output_fh}} $_[0], "\n";
  56         });
  57     $parser->parse_string_document( $buf );
  58
  59     return $non_pod_buf;
  60 }
  61
  62 sub check_operators {
  63     my %comma_space;
  64
  65     foreach my $file (@_) {
  66         my $path = @ARGV ? $file : $file->path();
  67
  68         # skip lex files
  69         next if $path =~ m/\.l$/;
  70
  71         my $buf = $DIST->slurp($path);
  72
  73         # only strip pod from .ops files
  74         if ( $path =~ m/\.ops$/ ) {
  75             $buf = strip_pod($buf);
  76         }
  77
  78         # strip ', ", and C comments #'
  79         $buf =~ s{ (?:
  80                        (?: (') (?: \\\\ | \\' | [^'] )* (') ) # rm ' string #'
  81                      | (?: (") (?: \\\\ | \\" | [^"] )* (") ) # rm " string #"
  82                      | /(\*) .*? (\*)/                        # rm C comment
  83                    )
  84                 }{defined $1 ? "$1$2" : defined $3 ? "$3$4" : "$5$6"}egsx;
  85
  86         my @lines = split( /\n/, $buf );
  87         $comma_space{$path} = [];
  88         for (my $i=0; $i <= $#lines; $i++) {
  89             # after a comma there should be one space or a newline
  90             if ( $lines[$i] =~ m{ ( (?:,) (?! \s ) (?= .+) ) }gx ) {
  91                 push @{ $comma_space{$path} }, $lines[$i];
  92             }
  93         }
  94     }
  95
  96 ## L<PDD07/Code Formatting"there should be one space or a newline after a comma">/
  97     my @comma_space_files;
  98     for my $path ( sort keys %comma_space ) {
  99         if (my $cnt = scalar  @{ $comma_space{$path} }) {
 100             push @comma_space_files, <<"END_ERROR";
 101 $path [$cnt line@{[ ($cnt >1) ? 's': '' ]}] at :
 102 @{[ join("\n--\n", @{$comma_space{$path}}) ]}
 103 END_ERROR
 104         }
 105     }
 106     is(join("\n",@comma_space_files),
 107        "",
 108        "there should be one space or a newline after a comma");
 109 }
 110
 111 # Local Variables:
 112 #   mode: cperl
 113 #   cperl-indent-level: 4
 114 #   fill-column: 100
 115 # End:
 116 # vim: expandtab shiftwidth=4: