t/structure/common_errors.t

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