Projekt

Allgemein

Profil

« Zurück | Weiter » 

Revision 31a9cb9d

Von Moritz Bunkus vor mehr als 13 Jahren hinzugefügt

  • ID 31a9cb9dbe9eb562576f69b77676e880781ed332
  • Vorgänger 0705a2b2
  • Nachfolger b95c5658

Testscript zum Auffinden häufiger Fehler (z.B. "my @foo = shift" oder "%bar->something()")

Unterschiede anzeigen:

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*=\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

  

Auch abrufbar als: Unified diff