t/codingstd/check_toxxx.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
  12 =head1 NAME
  13
  14 t/codingstd/check_toxxx.t - checks that the toxxx() functions are passed
  15 unsigned char
  16
  17 =head1 SYNOPSIS
  18
  19     # test all files
  20     % prove t/codingstd/check_toxxx.t
  21
  22     # test specific files
  23     % perl t/codingstd/check_toxxx.t src/foo.c include/parrot/bar.h
  24
  25 =head1 DESCRIPTION
  26
  27 Checks all C language files to make sure that arguments to the toxxx()
  28 functions are explicitly cast to unsigned char.
  29
  30 =head1 SEE ALSO
  31
  32 L<docs/pdds/pdd07_codingstd.pod>
  33
  34 =cut
  35
  36 my $DIST = Parrot::Distribution->new;
  37 my @files = @ARGV ? <@ARGV> : $DIST->get_c_language_files();
  38 my @no_explicit_cast;
  39 my $toxxx_functions = "toupper|tolower";
  40
  41 foreach my $file (@files) {
  42
  43     # if we have command line arguments, the file is the full path
  44     # otherwise, use the relevant Parrot:: path method
  45     my $path = @ARGV ? $file : $file->path;
  46
  47     my $buf = $DIST->slurp($path);
  48
  49     my @buffer_lines = split( /\n/, $buf );
  50
  51     # find out if toxxx() functions appear in the file
  52     my $num_toxxx = grep m/($toxxx_functions)\(/, @buffer_lines;
  53
  54     # if so, check if the args are cast to unsigned char
  55     if ($num_toxxx) {
  56
  57         # get the lines just matching toxxx
  58         my @toxxx_lines = grep m/($toxxx_functions)\(/, @buffer_lines;
  59
  60         # find the instances without the explicit cast
  61         my $num_no_cast = grep !m/($toxxx_functions)\(\(unsigned char\)/, @toxxx_lines;
  62
  63         $path .= "\n";
  64         push @no_explicit_cast, $path if $num_no_cast;
  65     }
  66     else {
  67         next;
  68     }
  69 }
  70
  71 ok( !scalar(@no_explicit_cast), 'toxxx() functions cast correctly' )
  72     or diag( "toxxx() function not cast to unsigned char "
  73         . scalar @no_explicit_cast
  74         . " files:\n@no_explicit_cast" );
  75
  76 # Local Variables:
  77 #   mode: cperl
  78 #   cperl-indent-level: 4
  79 #   fill-column: 100
  80 # End:
  81 # vim: expandtab shiftwidth=4: