t/structure/common_errors.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use threads;
   5 use lib 't';
   6 use Support::Files;
   7 use Sys::CPU;
   8 use Thread::Pool::Simple;
   9
  10 my ($testcount);
  11
  12 BEGIN {
  13   $testcount = scalar @Support::Files::testitems;
  14 }
  15
  16 use Test::More tests => $testcount;
  17
  18 # Capture the TESTOUT from Test::More or Test::Builder for printing errors.
  19 # This will handle verbosity for us automatically.
  20 my $fh;
  21 {
  22   local $^W = 0;                # Don't complain about non-existent filehandles
  23   if (-e \*Test::More::TESTOUT) {
  24     $fh = \*Test::More::TESTOUT;
  25   } elsif (-e \*Test::Builder::TESTOUT) {
  26     $fh = \*Test::Builder::TESTOUT;
  27   } else {
  28     $fh = \*STDOUT;
  29   }
  30 }
  31
  32 my @testitems = @Support::Files::testitems;
  33
  34 # at last, here we actually run the test...
  35
  36 my @common_errors = ([ '^\s*my\s+%[a-z0-9_]+\s*=\s*shift' ],
  37                      [ '^\s*my\s+\(.*\)\s*=\s*shift'      ],
  38                      [ '^\s*my\s+\$[^=]*=\s*@_'           ],
  39                      [ '@[a-z0-9_]+->'                    ],
  40                      [ 'uft8'                             ],
  41                      [ '\$slef'                           ],
  42                     );
  43
  44 sub test_file {
  45   my ($file) = @_;
  46   $file =~ s/\s.*$//;           # nuke everything after the first space (#comment)
  47   return if (!$file);           # skip null entries
  48
  49   if (open (FILE, $file)) {     # open the file for reading
  50     $_->[1] = [] foreach @common_errors;
  51
  52     my $line_number = 0;
  53     while (my $file_line = <FILE>) {
  54       $line_number++;
  55
  56       foreach my $re (@common_errors) {
  57         push @{ $re->[1] }, $line_number if $file_line =~ /$re->[0]/i;
  58       }
  59     }
  60
  61     close (FILE);
  62
  63     my $errors = join('  ', map { $_->[0] . ' (' . join(' ', @{ $_->[1] }) . ')' } grep { scalar @{ $_->[1] } } @common_errors);
  64     if ($errors) {
  65       ok(0,"$file: found common errors: $errors");
  66     } else {
  67       ok(1,"$file does not contain common errors");
  68     }
  69   } else {
  70     ok(0,"could not open $file for common errors check --WARNING");
  71   }
  72 }
  73
  74 my $pool = Thread::Pool::Simple->new(
  75   min    => 2,
  76   max    => Sys::CPU::cpu_count() + 1,
  77   do     => [ \&test_file ],
  78   passid => 0,
  79 );
  80
  81 $pool->add($_) for @testitems;
  82
  83 $pool->join;
  84
  85 exit 0;