Login
Require all Policies to have an AFFILIATION POD section.
[gknop/Perl-Critic.git] / t / 01_config.t
CommitLineData
faa35de4
JRT
1#!perl
2
e68db767 3##############################################################################
2e0f1c94
ES
4# $URL$
5# $Date$
27c1472f
JRT
6# $Author$
7# $Revision$
e68db767 8##############################################################################
27c1472f 9
59b05e08
JRT
10use strict;
11use warnings;
1c5955e4 12use File::Spec;
faa35de4 13use English qw(-no_match_vars);
e68db767 14use List::MoreUtils qw(all any);
3c5791fe 15use Perl::Critic::PolicyFactory (-test => 1);
410cf90b 16use Perl::Critic::Config qw();
bbf4108c 17use Perl::Critic::Utils qw{ :severities };
badbf753 18use Test::More (tests => 73);
59b05e08 19
bf159007 20# common P::C testing tools
936d9576
ES
21use Perl::Critic::TestUtils qw{
22 bundled_policy_names
23 names_of_policies_willing_to_work
24 };
25
1c2cd49f 26Perl::Critic::TestUtils::block_perlcriticrc();
bf159007 27
e68db767 28#-----------------------------------------------------------------------------
bd313feb 29
936d9576
ES
30my @names_of_policies_willing_to_work = names_of_policies_willing_to_work();
31my @native_policy_names = bundled_policy_names();
32my $total_policies = scalar @names_of_policies_willing_to_work;
59b05e08 33
e68db767 34#-----------------------------------------------------------------------------
9e2cb0fd
JRT
35# Test default config. Increasing the severity should yield
36# fewer and fewer policies. The exact number will fluctuate
6288d2b4 37# as we introduce new polices and/or change their severity.
59b05e08 38
e68db767
JRT
39{
40 my $last_policy_count = $total_policies + 1;
41 for my $severity ($SEVERITY_LOWEST .. $SEVERITY_HIGHEST) {
42 my $c = Perl::Critic::Config->new( -severity => $severity);
43 my $policy_count = scalar $c->policies();
44 my $test_name = "Count native policies, severity: $severity";
45 cmp_ok($policy_count, '<', $last_policy_count, $test_name);
46 $last_policy_count = $policy_count;
47 }
9e2cb0fd 48}
59b05e08 49
59b05e08 50
e68db767 51#-----------------------------------------------------------------------------
bb08289e 52# Same tests as above, but using a generated config
59b05e08 53
e68db767 54{
936d9576 55 my %profile = map { $_ => {} } @native_policy_names;
e68db767
JRT
56 my $last_policy_count = $total_policies + 1;
57 for my $severity ($SEVERITY_LOWEST .. $SEVERITY_HIGHEST) {
bb08289e
JRT
58 my %pc_args = (-profile => \%profile, -severity => $severity);
59 my $critic = Perl::Critic::Config->new( %pc_args );
60 my $policy_count = scalar $critic->policies();
e68db767
JRT
61 my $test_name = "Count all policies, severity: $severity";
62 cmp_ok($policy_count, '<', $last_policy_count, $test_name);
63 $last_policy_count = $policy_count;
64 }
9e2cb0fd 65}
59b05e08 66
e68db767 67#-----------------------------------------------------------------------------
9e2cb0fd
JRT
68# Test all-off config w/ various severity levels. In this case, the
69# severity level should not affect the number of polices because we've
bb08289e 70# turned them all off in the profile.
59b05e08 71
bd313feb 72{
936d9576 73 my %profile = map { '-' . $_ => {} } @native_policy_names;
bd313feb 74 for my $severity (undef, $SEVERITY_LOWEST .. $SEVERITY_HIGHEST) {
bb08289e
JRT
75 my %pc_args = (-profile => \%profile, -severity => $severity);
76 my @policies = Perl::Critic::Config->new( %pc_args )->policies();
77 my $test_name = 'no policies, severity ' . ($severity || 'undef');
78 is_deeply( \@policies, [], $test_name);
bd313feb 79 }
9e2cb0fd 80}
1e7b8681 81
6036a254 82#-----------------------------------------------------------------------------
bb08289e
JRT
83# Test config w/ multiple severity levels. In this profile, we
84# define an arbitrary severity for each Policy so that severity
9e2cb0fd
JRT
85# levels 5 through 2 each have 10 Policies. All remaining Policies
86# are in the 1st severity level.
87
dc93df4f 88
8fc09ae2 89{
bb08289e 90 my %profile = ();
dc93df4f 91 my $last_policy_count = 0;
bb08289e 92 my $severity = $SEVERITY_HIGHEST;
936d9576 93 for my $index ( 0 .. $#names_of_policies_willing_to_work ) {
bb08289e
JRT
94 $severity-- if $index && $index % 10 == 0;
95 $severity = $SEVERITY_LOWEST if $severity < $SEVERITY_LOWEST;
936d9576
ES
96 $profile{$names_of_policies_willing_to_work[$index]} =
97 {severity => $severity};
bb08289e
JRT
98 }
99
8fc09ae2 100 for my $severity ( reverse $SEVERITY_LOWEST+1 .. $SEVERITY_HIGHEST ) {
bb08289e
JRT
101 my %pc_args = (-profile => \%profile, -severity => $severity);
102 my $critic = Perl::Critic::Config->new( %pc_args );
103 my $policy_count = scalar $critic->policies();
104 my $expected_count = ($SEVERITY_HIGHEST - $severity + 1) * 10;
105 my $test_name = "user-defined severity level: $severity";
106 is( $policy_count, $expected_count, $test_name );
8fc09ae2 107 }
9e2cb0fd 108
bb08289e
JRT
109 # All remaining policies should be at the lowest severity
110 my %pc_args = (-profile => \%profile, -severity => $SEVERITY_LOWEST);
111 my $critic = Perl::Critic::Config->new( %pc_args );
112 my $policy_count = scalar $critic->policies();
113 my $expected_count = $SEVERITY_HIGHEST * 10;
114 my $test_name = "user-defined severity, all remaining policies";
115 cmp_ok( $policy_count, '>=', $expected_count, $test_name);
9e2cb0fd 116}
59b05e08 117
e68db767
JRT
118#-----------------------------------------------------------------------------
119# Test config with defaults
59b05e08 120
e68db767 121{
1c5955e4
JRT
122 my $examples_dir = 'examples';
123 my $profile = File::Spec->catfile( $examples_dir, 'perlcriticrc' );
e68db767 124 my $c = Perl::Critic::Config->new( -profile => $profile );
98768f5b
JRT
125
126 is_deeply([$c->exclude()], [ qw(Documentation Naming) ],
127 'user default exclude from file' );
128
129 is_deeply([$c->include()], [ qw(CodeLayout Modules) ],
130 'user default include from file' );
131
410cf90b 132 is($c->force(), 1, 'user default force from file' );
410cf90b
JRT
133 is($c->only(), 1, 'user default only from file' );
134 is($c->severity(), 3, 'user default severity from file' );
3bd89c31 135 is($c->theme()->rule(), 'danger || risky && ! pbp', 'user default theme from file');
410cf90b
JRT
136 is($c->top(), 50, 'user default top from file' );
137 is($c->verbose(), 5, 'user default verbose from file' );
e68db767 138}
c5d8050b 139
e68db767
JRT
140#-----------------------------------------------------------------------------
141#Test pattern matching
c5d8050b 142
c5d8050b 143
e68db767
JRT
144{
145 # In this test, we'll use a cusotm profile to deactivate some
146 # policies, and then use the -include option to re-activate them. So
147 # the net result is that we should still end up with the all the
148 # policies.
149
150 my %profile = (
151 '-NamingConventions::ProhibitMixedCaseVars' => {},
152 '-NamingConventions::ProhibitMixedCaseSubs' => {},
153 '-Miscellanea::RequireRcsKeywords' => {},
154 );
155
156 my @in = qw(mixedcase RCS);
157 my %pc_config = (-severity => 1, -profile => \%profile, -include => \@in);
158 my @pols = Perl::Critic::Config->new( %pc_config )->policies();
159 is(scalar @pols, $total_policies, 'pattern matching');
160}
c5d8050b 161
e68db767 162#-----------------------------------------------------------------------------
59b05e08 163
e68db767
JRT
164{
165 # For this test, we'll load the default config, but deactivate some of
166 # the policies using the -exclude option. Then we make sure that none
167 # of the remaining policies match the -exclude patterns.
168
169 my @ex = qw(quote mixed VALUES); #Some assorted pattterns
170 my @pols = Perl::Critic::Config->new( -severity => 1, -exclude => \@ex )->policies();
171 my $matches = grep { my $pol = ref $_; grep { $pol !~ /$_/imx} @ex } @pols;
172 is(scalar @pols, $matches, 'pattern matching');
173}
59b05e08 174
e68db767 175#-----------------------------------------------------------------------------
c5d8050b 176
e68db767
JRT
177{
178 # In this test, we set -include and -exclude patterns to both match
179 # some of the same policies. The -exclude option should have
180 # precendece.
181
182 my @in = qw(builtinfunc); #Include BuiltinFunctions::*
183 my @ex = qw(block); #Exclude RequireBlockGrep, RequireBlockMap
184 my %pc_config = ( -severity => 1, -include => \@in, -exclude => \@ex );
185 my @pols = Perl::Critic::Config->new( %pc_config )->policies();
186 my @pol_names = map {ref $_} @pols;
187 is_deeply( [grep {/block/imx} @pol_names], [], 'pattern match' );
188 # This odd construct arises because "any" can't be used with parens without syntax error(!)
189 ok( @{[any {/builtinfunc/imx} @pol_names]}, 'pattern match' );
190}
59b05e08 191
e68db767 192#-----------------------------------------------------------------------------
58247edc
JRT
193# Test the switch behavior
194
195{
badbf753
JRT
196 my @switches = qw(
197 -top
198 -verbose
199 -theme
200 -severity
201 -only
202 -force
203 -color
204 -criticism-fatal
205 );
206
58247edc
JRT
207 my %undef_args = map { $_ => undef } @switches;
208 my $c = Perl::Critic::Config->new( %undef_args );
209 is( $c->force(), 0, 'Undefined -force');
210 is( $c->only(), 0, 'Undefined -only');
211 is( $c->severity(), 5, 'Undefined -severity');
3bd89c31 212 is( $c->theme()->rule(), q{}, 'Undefined -theme');
58247edc 213 is( $c->top(), 0, 'Undefined -top');
badbf753 214 is( $c->color(), 1, 'Undefined -color');
5c1a155a 215 is( $c->verbose(), 4, 'Undefined -verbose');
badbf753 216 is( $c->criticism_fatal(), 0, 'Undefined -criticism-fatal');
58247edc
JRT
217
218 my %zero_args = map { $_ => 0 } @switches;
219 $c = Perl::Critic::Config->new( %zero_args );
7b84ff16
JRT
220 is( $c->force(), 0, 'zero -force');
221 is( $c->only(), 0, 'zero -only');
222 is( $c->severity(), 1, 'zero -severity');
3bd89c31 223 is( $c->theme()->rule(), q{}, 'zero -theme');
7b84ff16 224 is( $c->top(), 0, 'zero -top');
badbf753 225 is( $c->color(), 0, 'zero -color');
5c1a155a 226 is( $c->verbose(), 4, 'zero -verbose');
badbf753 227 is( $c->criticism_fatal(), 0, 'zero -criticism-fatal');
58247edc
JRT
228
229 my %empty_args = map { $_ => q{} } @switches;
230 $c = Perl::Critic::Config->new( %empty_args );
7b84ff16
JRT
231 is( $c->force(), 0, 'empty -force');
232 is( $c->only(), 0, 'empty -only');
233 is( $c->severity(), 1, 'empty -severity');
3bd89c31 234 is( $c->theme->rule(), q{}, 'empty -theme');
7b84ff16 235 is( $c->top(), 0, 'empty -top');
badbf753 236 is( $c->color(), 0, 'empty -color');
5c1a155a 237 is( $c->verbose(), 4, 'empty -verbose');
badbf753 238 is( $c->criticism_fatal(), 0, 'empty -criticism-fatal');
58247edc
JRT
239}
240
241#-----------------------------------------------------------------------------
410cf90b
JRT
242# Test the -only switch
243
244{
410cf90b
JRT
245 my %profile = (
246 '-NamingConventions::ProhibitMixedCaseVars' => {},
247 'NamingConventions::ProhibitMixedCaseSubs' => {},
248 'Miscellanea::RequireRcsKeywords' => {},
249 );
250
251 my %pc_config = (-severity => 1, -only => 1, -profile => \%profile);
252 my @pols = Perl::Critic::Config->new( %pc_config )->policies();
253 is(scalar @pols, 2, '-only switch');
254
255 %pc_config = ( -severity => 1, -only => 1, -profile => {} );
256 @pols = Perl::Critic::Config->new( %pc_config )->policies();
257 is(scalar @pols, 0, '-only switch, empty profile');
258}
259
260#-----------------------------------------------------------------------------
738830ba 261# Test the -single-policy switch
98768f5b
JRT
262
263{
738830ba 264 my %pc_config = ('-single-policy' => 'ProhibitEvilModules');
98768f5b 265 my @pols = Perl::Critic::Config->new( %pc_config )->policies();
738830ba 266 is(scalar @pols, 1, '-single-policy switch');
98768f5b
JRT
267}
268
269#-----------------------------------------------------------------------------
7b84ff16
JRT
270# Test interaction between switches and defaults
271
272{
273 my %true_defaults = ( force => 1, only => 1, top => 10 );
2e0f1c94 274 my %profile = ( '__defaults__' => \%true_defaults );
7b84ff16
JRT
275
276 my %pc_config = (-force => 0, -only => 0, -top => 0, -profile => \%profile);
277 my $config = Perl::Critic::Config->new( %pc_config );
278 is( $config->force, 0, '-force: default is true, arg is false');
279 is( $config->only, 0, '-only: default is true, arg is false');
280 is( $config->top, 0, '-top: default is true, arg is false');
281}
282
283#-----------------------------------------------------------------------------
0bcb38c0
JRT
284# Test named severity levels
285
286{
287 my %severity_levels = (gentle=>5, stern=>4, harsh=>3, cruel=>2, brutal=>1);
288 while (my ($name, $number) = each %severity_levels) {
289 my $config = Perl::Critic::Config->new( -severity => $name );
98768f5b 290 is( $config->severity(), $number, qq{Severity "$name" is "$number"});
0bcb38c0
JRT
291 }
292}
293
294
295#-----------------------------------------------------------------------------
dc93df4f 296# Test exception handling
faa35de4
JRT
297
298{
e68db767
JRT
299 my $config = Perl::Critic::Config->new( -profile => 'NONE' );
300
301 # Try adding a bogus policy
302 eval{ $config->add_policy( -policy => 'Bogus::Policy') };
303 like( $EVAL_ERROR, qr/Unable to create policy/, 'add_policy w/ bad args' );
bd0b9365 304
e68db767
JRT
305 # Try adding w/o policy
306 eval { $config->add_policy() };
307 like( $EVAL_ERROR, qr/The -policy argument is required/, 'add_policy w/o args' );
0bcb38c0
JRT
308
309 # Try using bogus named severity level
310 eval{ Perl::Critic::Config->new( -severity => 'bogus' ) };
2e0f1c94
ES
311 like(
312 $EVAL_ERROR,
ee5a2bbd 313 qr/The value for the global "-severity" option \("bogus"\) is not one of the valid severity names/,
2e0f1c94
ES
314 'invalid severity'
315 );
98768f5b 316
738830ba
ES
317 # Try using vague -single-policy option
318 eval{ Perl::Critic::Config->new( '-single-policy' => '.*' ) };
ee5a2bbd 319 like( $EVAL_ERROR, qr/matched multiple policies/, 'vague -single-policy' );
98768f5b 320
738830ba
ES
321 # Try using invalid -single-policy option
322 eval{ Perl::Critic::Config->new( '-single-policy' => 'bogus' ) };
ee5a2bbd 323 like( $EVAL_ERROR, qr/did not match any policies/, 'invalid -single-policy' );
bd0b9365
JRT
324}
325
34cc6052
ES
326#-----------------------------------------------------------------------------
327
936d9576 328# ensure we run true if this test is loaded by
34cc6052 329# t/01_config.t_without_optional_dependencies.t
936d9576
ES
3301;
331
98768f5b 332##############################################################################
737d3b65
CD
333# Local Variables:
334# mode: cperl
335# cperl-indent-level: 4
336# fill-column: 78
337# indent-tabs-mode: nil
338# c-indentation-style: bsd
339# End:
96fed375 340# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :