line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#line 1 |
2
|
|
|
|
|
|
|
####################################################################### |
3
|
|
|
|
|
|
|
# $URL: http://perlcritic.tigris.org/svn/perlcritic/tags/Test-Perl-Critic-1.01/lib/Test/Perl/Critic.pm $ |
4
|
|
|
|
|
|
|
# $Date: 2007-01-24 22:22:10 -0800 (Wed, 24 Jan 2007) $ |
5
|
|
|
|
|
|
|
# $Author: thaljef $ |
6
|
|
|
|
|
|
|
# $Revision: 1183 $ |
7
|
|
|
|
|
|
|
######################################################################## |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
package Test::Perl::Critic; |
10
|
1
|
|
|
1
|
|
625
|
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
28
|
|
11
|
1
|
|
|
1
|
|
5
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
32
|
|
12
|
1
|
|
|
1
|
|
11
|
use warnings; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
64
|
|
13
|
1
|
|
|
1
|
|
1177
|
use Carp qw(croak); |
|
1
|
|
|
|
|
2134
|
|
|
1
|
|
|
|
|
487
|
|
14
|
1
|
|
|
1
|
|
404
|
use English qw(-no_match_vars); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
13
|
|
15
|
1
|
|
|
1
|
|
2484
|
use Test::Builder qw(); |
|
1
|
|
|
|
|
1784048
|
|
|
1
|
|
|
|
|
27
|
|
16
|
1
|
|
|
1
|
|
11
|
use Perl::Critic qw(); |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
19
|
|
17
|
1
|
|
|
1
|
|
6
|
use Perl::Critic::Violation qw(); |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
16
|
|
18
|
|
|
|
|
|
|
use Perl::Critic::Utils; |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
#--------------------------------------------------------------------------- |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
our $VERSION = 1.01; |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
#--------------------------------------------------------------------------- |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
my $TEST = Test::Builder->new(); |
28
|
|
|
|
|
|
|
my %CRITIC_ARGS = (); |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
#--------------------------------------------------------------------------- |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
sub import { |
33
|
1
|
|
|
1
|
|
10
|
|
34
|
1
|
|
|
|
|
3
|
my ( $self, %args ) = @_; |
35
|
|
|
|
|
|
|
my $caller = caller; |
36
|
1
|
|
|
1
|
|
1030
|
|
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
596
|
|
37
|
1
|
|
|
|
|
2
|
no strict 'refs'; ## no critic |
|
1
|
|
|
|
|
6
|
|
38
|
1
|
|
|
|
|
3
|
*{ $caller . '::critic_ok' } = \&critic_ok; |
|
1
|
|
|
|
|
4
|
|
39
|
|
|
|
|
|
|
*{ $caller . '::all_critic_ok' } = \&all_critic_ok; |
40
|
1
|
|
|
|
|
7
|
|
41
|
|
|
|
|
|
|
$TEST->exported_to($caller); |
42
|
|
|
|
|
|
|
|
43
|
1
|
50
|
|
|
|
14
|
# -format is supported for backward compatibility |
|
0
|
|
|
|
|
0
|
|
44
|
1
|
|
|
|
|
3
|
if( exists $args{-format} ){ $args{-verbose} = $args{-format}; } |
45
|
|
|
|
|
|
|
%CRITIC_ARGS = %args; |
46
|
1
|
|
|
|
|
13
|
|
47
|
|
|
|
|
|
|
return 1; |
48
|
|
|
|
|
|
|
} |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
#--------------------------------------------------------------------------- |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
sub critic_ok { |
53
|
1
|
|
|
1
|
1
|
3
|
|
54
|
1
|
50
|
|
|
|
7
|
my ( $file, $test_name ) = @_; |
55
|
1
|
50
|
|
|
|
22
|
croak q{no file specified} if not defined $file; |
56
|
1
|
|
33
|
|
|
8
|
croak qq{"$file" does not exist} if not -f $file; |
57
|
|
|
|
|
|
|
$test_name ||= qq{Test::Perl::Critic for "$file"}; |
58
|
1
|
|
|
|
|
2
|
|
59
|
1
|
|
|
|
|
2
|
my $critic = undef; |
60
|
1
|
|
|
|
|
1
|
my @violations = (); |
61
|
|
|
|
|
|
|
my $ok = 0; |
62
|
|
|
|
|
|
|
|
63
|
1
|
|
|
|
|
3
|
# Run Perl::Critic |
64
|
|
|
|
|
|
|
eval { |
65
|
1
|
|
|
|
|
9
|
# TODO: Should $critic be a global singleton? |
66
|
1
|
|
|
|
|
484970
|
$critic = Perl::Critic->new( %CRITIC_ARGS ); |
67
|
1
|
|
|
|
|
197252
|
@violations = $critic->critique( $file ); |
68
|
|
|
|
|
|
|
$ok = not scalar @violations; |
69
|
|
|
|
|
|
|
}; |
70
|
|
|
|
|
|
|
|
71
|
1
|
|
|
|
|
14
|
# Evaluate results |
72
|
|
|
|
|
|
|
$TEST->ok( $ok, $test_name ); |
73
|
|
|
|
|
|
|
|
74
|
1
|
50
|
|
|
|
382
|
|
|
|
50
|
|
|
|
|
|
75
|
0
|
|
|
|
|
0
|
if ($EVAL_ERROR) { # Trap exceptions from P::C |
76
|
0
|
|
|
|
|
0
|
$TEST->diag( "\n" ); # Just to get on a new line. |
77
|
0
|
|
|
|
|
0
|
$TEST->diag( qq{Perl::Critic had errors in "$file":} ); |
78
|
|
|
|
|
|
|
$TEST->diag( qq{\t$EVAL_ERROR} ); |
79
|
|
|
|
|
|
|
} |
80
|
0
|
|
|
|
|
0
|
elsif ( not $ok ) { # Report Policy violations |
81
|
0
|
|
|
|
|
0
|
$TEST->diag( "\n" ); # Just to get on a new line. |
82
|
|
|
|
|
|
|
$TEST->diag( qq{Perl::Critic found these violations in "$file":} ); |
83
|
0
|
|
|
|
|
0
|
|
84
|
0
|
|
|
|
|
0
|
my $verbose = $critic->config->verbose(); |
85
|
0
|
|
|
|
|
0
|
Perl::Critic::Violation::set_format( $verbose ); |
|
0
|
|
|
|
|
0
|
|
86
|
|
|
|
|
|
|
for my $viol (@violations) { $TEST->diag("$viol") } |
87
|
|
|
|
|
|
|
} |
88
|
1
|
|
|
|
|
580
|
|
89
|
|
|
|
|
|
|
return $ok; |
90
|
|
|
|
|
|
|
} |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
#--------------------------------------------------------------------------- |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
sub all_critic_ok { |
95
|
1
|
50
|
|
1
|
1
|
10
|
|
96
|
1
|
|
|
|
|
3
|
my @dirs = @_ ? @_ : _starting_points(); |
97
|
1
|
|
|
|
|
501
|
my @files = all_code_files( @dirs ); |
98
|
|
|
|
|
|
|
$TEST->plan( tests => scalar @files ); |
99
|
1
|
|
|
|
|
589
|
|
|
1
|
|
|
|
|
4
|
|
100
|
1
|
|
|
|
|
119
|
my $okays = grep { critic_ok($_) } @files; |
101
|
|
|
|
|
|
|
return $okays == @files; |
102
|
|
|
|
|
|
|
} |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
#--------------------------------------------------------------------------- |
105
|
|
|
|
|
|
|
|
106
|
1
|
50
|
|
1
|
1
|
3
|
sub all_code_files { |
107
|
1
|
|
|
|
|
5
|
my @dirs = @_ ? @_ : _starting_points(); |
108
|
|
|
|
|
|
|
return Perl::Critic::Utils::all_perl_files(@dirs); |
109
|
|
|
|
|
|
|
} |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
#--------------------------------------------------------------------------- |
112
|
|
|
|
|
|
|
|
113
|
0
|
0
|
|
0
|
|
|
sub _starting_points { |
114
|
|
|
|
|
|
|
return -e 'blib' ? 'blib' : 'lib'; |
115
|
|
|
|
|
|
|
} |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
#--------------------------------------------------------------------------- |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
1; |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
__END__ |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
#line 412 |