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