Revision 31a9cb9d
Von Moritz Bunkus vor mehr als 13 Jahren hinzugefügt
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
Testscript zum Auffinden häufiger Fehler (z.B. "my @foo = shift" oder "%bar->something()")