t/codingstd/c_parens.t

   1 #! perl
   2 # Copyright (C) 2006-2010, Parrot Foundation.
   3 # $Id$
   4
   5 use strict;
   6 use warnings;
   7
   8 use lib qw( . lib ../lib ../../lib );
   9 use Test::More tests => 3;
  10 use Parrot::Distribution;
  11 use Pod::Simple;
  12
  13 =head1 NAME
  14
  15 t/codingstd/c_parens.t - checks for rules related to parentheses in C source
  16
  17 =head1 SYNOPSIS
  18
  19     # test all files
  20     % prove t/codingstd/c_parens.t
  21
  22     # test specific files
  23     % perl t/codingstd/c_parens.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 parentheses,
  28 as specified in PDD07.
  29
  30 =head1 SEE ALSO
  31
  32 L<docs/pdds/pdd07_codingstd.pod>
  33
  34 =cut
  35
  36 my $keywords = join '|' => sort { length $a <=> length $b } qw/
  37     auto      double    int       struct    INTVAL
  38     break     else      long      switch    UINTVAL
  39     case      enum      register  typedef   FLOATVAL
  40     char      extern    return    union     PIOOFF_T
  41     const     float     short     unsigned
  42     continue  for       signed    void
  43     default   goto      sizeof    volatile  opcode_t
  44     do        if        static    while     size_t
  45     /;
  46 my $DIST = Parrot::Distribution->new;
  47 my @files = @ARGV ? <@ARGV> : $DIST->get_c_language_files();
  48 check_parens(@files);
  49
  50 exit;
  51
  52 sub strip_pod {
  53     my $buf = shift;
  54     my $parser = Pod::Simple->new();
  55     my $non_pod_buf;
  56     $parser->output_string( \$non_pod_buf );
  57     # set up a code handler to get at the non-pod
  58     # thanks to Thomas Klausner's Pod::Strip for the inspiration
  59     $parser->code_handler(
  60         sub {
  61             print {$_[2]{output_fh}} $_[0], "\n";
  62         });
  63     $parser->parse_string_document( $buf );
  64
  65     return $non_pod_buf;
  66 }
  67
  68 sub check_parens {
  69     my @keyword_paren;
  70     my @non_keyword_paren;
  71     my @space_between_parens;
  72
  73     foreach my $file (@_) {
  74         my $path = @ARGV ? $file : $file->path();
  75
  76         my $buf = $DIST->slurp($path);
  77
  78         # only strip pod from .ops files
  79         if ( $path =~ m/\.ops$/ ) {
  80             $buf = strip_pod($buf);
  81         }
  82
  83         # strip ', ", and C comments
  84         $buf =~ s{ (?:
  85                        (?: (') (?: \\\\ | \\' | [^'] )* (') ) # remove ' string
  86                      | (?: (") (?: \\\\ | \\" | [^"] )* (") ) # remove " string
  87                      | /(\*) .*? (\*)/                        # remove C comment
  88                    )
  89                 }{defined $1 ? "$1$2" : defined $3 ? "$3$4" : "$5$6"}egsx;
  90
  91         my @lines = split( /\n/, $buf );
  92         for my $line (@lines) {
  93             # skip #defines and typedefs
  94             next if $line =~ m{(?:(#\s*define|^\s*typedef))};
  95             if ( $line =~ m{ ( (?<!\w) (?:$keywords) (?: \( ) ) }xo ) {
  96                 my $paren = $1;
  97
  98                 # ops use the same names as some C keywords, so skip
  99                 next if $line =~ m{^op};
 100                 push @keyword_paren => "$path: $paren";
 101             }
 102             if ( $line =~ m{ ( (?<!\w) (?!(?:$keywords)\W) \w+ \s+ \( ) }xo ) {
 103                 push @non_keyword_paren => "$path: $1";
 104             }
 105             if ( $line =~ m{ ( \( [ \t]+ [^\n] | [^\n] [ \t]+ \) ) }x ) {
 106                 push @space_between_parens => "$path: $1";
 107             }
 108         }
 109     }
 110
 111 ## L<PDD07/Code Formatting/"there should be at least one space between a C keyword and any subsequent open parenthesis">
 112     is( join("\n",@keyword_paren), "", <<END_DESCRIPTION);
 113 there should be at least one space between a C
 114 keyword and any subsequent open parenthesis
 115 END_DESCRIPTION
 116
 117 ## L<PDD07/Code Formatting/"There should be no space between a function name and the following open parenthesis">
 118     is( join("\n",@non_keyword_paren), "", <<END_DESCRIPTION);
 119 There should be no space between a function name
 120 and the following open parenthesis
 121 END_DESCRIPTION
 122
 123 ## L<PDD07/Code Formatting/"parentheses should not have space immediately after the opening parenthesis nor immediately before the closing parenthesis">
 124     is( join("\n",@space_between_parens), "", <<END_DESCRIPTION);
 125 parentheses should not have space immediately
 126 after the opening parenthesis nor immediately
 127 before the closing parenthesis
 128 END_DESCRIPTION
 129
 130 }
 131
 132 # Local Variables:
 133 #   mode: cperl
 134 #   cperl-indent-level: 4
 135 #   fill-column: 100
 136 # End:
 137 # vim: expandtab shiftwidth=4: