1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
|
#!perl
## Run Perl::Critic against the source code and the tests
## This is highly customized, so take with a grain of salt
use 5.008;
use strict;
use warnings;
use Test::More;
use Data::Dumper;
my @testfiles;
if (!$ENV{RELEASE_TESTING}) {
plan (skip_all => 'Test skipped unless environment variable RELEASE_TESTING is set');
}
elsif (!eval { require Perl::Critic; 1 }) {
plan skip_all => 'Could not find Perl::Critic';
}
elsif ($Perl::Critic::VERSION < 0.23) {
plan skip_all => 'Perl::Critic must be version 0.23 or higher';
}
else {
opendir my $dir, 't' or die qq{Could not open directory 't': $!\n};
@testfiles = map { "t/$_" } grep { /^.+\.(t|pl)$/ } readdir $dir;
closedir $dir;
plan tests => 5+@testfiles;
}
ok(@testfiles, 'Found files in test directory');
## Check some non-test files
my $critic = Perl::Critic->new(-severity => 1, '-profile-strictness' => 'quiet');
for my $filename (qw{Makefile.PL check_postgres.pl t/CP_Testing.pm}) {
if ($ENV{TEST_CRITIC_SKIPNONTEST}) {
pass qq{Skipping non-test file "$filename"};
next;
}
-e $filename or die qq{Could not find "$filename"!};
open my $oldstderr, '>&', \*STDERR or die 'Could not dupe STDERR';
close STDERR or die qq{Could not close STDERR: $!};
my @vio;
my $ranok = 0;
eval {
@vio = $critic->critique($filename);
$ranok = 1;
};
if (! $ranok) {
pass "Perl::Critic failed for file $filename. Error was: $@\n";
$@ = undef;
next;
}
open STDERR, '>&', $oldstderr or die 'Could not recreate STDERR'; ## no critic
close $oldstderr or die qq{Could not close STDERR copy: $!};
my $vios = 0;
VIO: for my $v (@vio) {
my $d = $v->description();
(my $policy = $v->policy()) =~ s/Perl::Critic::Policy:://;
my $source = $v->source();
if ($filename =~ /test/io) {
next VIO if $policy =~ /RequireArgUnpacking/o
or $policy =~ /RequireVersionVar/o;
}
if ($filename =~ /Makefile/o) {
next VIO if $policy =~ /RequireVersionVar/o
or $policy =~ /ProhibitBooleanGrep/o
or $policy =~ /RequireInterpolationOfMetachars/o;
}
$vios++;
my $f = $v->filename();
my $l = $v->location();
my $line = $l->[0];
diag "\nFile: $f (line $line)\n";
diag "Vio: $d\n";
diag "Policy: $policy\n";
diag "Source: $source\n\n";
}
if ($vios) {
fail qq{ Failed Perl::Critic tests for file "$filename": $vios};
}
else {
pass qq{ File "$filename" passed all Perl::Critic tests};
}
}
## Specific exclusions for test scripts:
my %ok =
(yaml => {
sub => 'meta_spec_ok',
},
pod => {
sub => 'pod_file_ok pod_coverage_ok',
},
signature => {
sub => 'verify SIGNATURE_OK',
},
);
for my $f (keys %ok) {
for my $ex (keys %{$ok{$f}}) {
if ($ex eq 'sub') {
for my $foo (split /\s+/ => $ok{$f}{sub}) {
push @{$ok{$f}{OK}} => qr{Subroutine "$foo" (?:is neither|not exported)};
}
}
else {
die "Unknown exception '$ex'\n";
}
}
}
## Allow Test::More subroutines
my $tm = join '|' => (qw/skip plan pass fail is ok diag BAIL_OUT/);
my $testmoreok = qr{Subroutine "$tm" is neither};
## Create a new critic for the tests
$critic = Perl::Critic->new(-severity => 1, '-profile-strictness' => 'quiet');
my $count = 1;
for my $filename (sort @testfiles) {
-e $filename or die qq{Could not find "$filename"!};
my @vio = $critic->critique($filename);
my $vios = 0;
VIO: for my $v (@vio) {
my $d = $v->description();
(my $policy = $v->policy()) =~ s/Perl::Critic::Policy:://;
my $source = $v->source();
my $f = $v->filename();
## Skip common Test::More subroutines:
next if $d =~ $testmoreok;
## Specific 'test files' exceptions
next if $policy =~ /Modules::RequireVersionVar/o;
## Skip other specific items:
for my $k (sort keys %ok) {
next unless $f =~ /$k/;
for (@{$ok{$k}{OK}}) {
next VIO if $d =~ $_;
}
}
$vios++;
my $l = $v->location();
my $line = $l->[0];
my $pbp = $v->explanation();
diag "\nFile: $f (line $line)\n";
diag "Vio: $d\n";
diag "Policy: $policy\n";
diag "Source: $source\n";
diag "PBP says: $pbp\n\n";
}
my $SPACE = ++$count < 9 ? ' ' : '';
if ($vios) {
fail qq{${SPACE}Failed Perl::Critic tests for file "$filename": $vios};
}
else {
pass qq{${SPACE}File "$filename" passed all Perl::Critic tests};
}
}
pass('Finished Perl::Critic testing');
exit;
|
