Login
Regenerated MANIFEST and META
[gknop/Perl-Critic.git] / t / 01_config.t
CommitLineData
faa35de4
JRT
1#!perl
2
27c1472f
JRT
3##################################################################
4# $URL$
5# $Date$
6# $Author$
7# $Revision$
8##################################################################
9
59b05e08
JRT
10use strict;
11use warnings;
dc93df4f
JRT
12use Test::More tests => 28;
13use List::MoreUtils qw(all any);
faa35de4 14use English qw(-no_match_vars);
9e2cb0fd 15use Perl::Critic::Utils;
f6474d13 16use Perl::Critic::Config (-test => 1);
59b05e08
JRT
17use Perl::Critic;
18
bf159007 19# common P::C testing tools
1c2cd49f
JRT
20use Perl::Critic::TestUtils qw();
21Perl::Critic::TestUtils::block_perlcriticrc();
bf159007 22
9e2cb0fd 23my $samples_dir = 't/samples';
dc93df4f 24my $critic = Perl::Critic->new(-severity => $SEVERITY_LOWEST);
bd313feb 25my @native_policies = Perl::Critic::Config::native_policies();
dc93df4f 26my @all_policies = map {ref $_} $critic->policies();
bd313feb
CD
27
28# Note that the user may have third-party policies installed, so the
29# reported number of policies may be higher than native_policies()
30my $have_third_party_policies = @all_policies > @native_policies;
31my $total_policies = scalar $have_third_party_policies ?
32 @all_policies : @native_policies;
59b05e08 33
9e2cb0fd
JRT
34my $last_policy_count = 0;
35my $profile = undef;
59b05e08
JRT
36
37#--------------------------------------------------------------
9e2cb0fd
JRT
38# Test default config. Increasing the severity should yield
39# fewer and fewer policies. The exact number will fluctuate
6288d2b4 40# as we introduce new polices and/or change their severity.
59b05e08 41
9e2cb0fd
JRT
42$last_policy_count = $total_policies + 1;
43for my $severity ($SEVERITY_LOWEST .. $SEVERITY_HIGHEST) {
dc93df4f
JRT
44 my $c = Perl::Critic->new( -severity => $severity);
45 my $policy_count = scalar $c->policies();
6288d2b4
JRT
46 my $test_name = "Count native policies, severity: $severity";
47 cmp_ok($policy_count, '<', $last_policy_count, $test_name);
9e2cb0fd
JRT
48 $last_policy_count = $policy_count;
49}
59b05e08 50
59b05e08 51
1e7b8681 52#--------------------------------------------------------------
9e2cb0fd 53# Same tests as above, but using a config file
59b05e08 54
9e2cb0fd
JRT
55$profile = "$samples_dir/perlcriticrc.all";
56$last_policy_count = $total_policies + 1;
57for my $severity ($SEVERITY_LOWEST .. $SEVERITY_HIGHEST) {
dc93df4f
JRT
58 my $c = Perl::Critic->new( -profile => $profile, -severity => $severity);
59 my $policy_count = scalar $c->policies();
6288d2b4
JRT
60 my $test_name = "Count all policies, severity: $severity";
61 cmp_ok($policy_count, '<', $last_policy_count, $test_name);
9e2cb0fd
JRT
62 $last_policy_count = $policy_count;
63}
59b05e08 64
9e2cb0fd
JRT
65#--------------------------------------------------------------
66# Test all-off config w/ various severity levels. In this case, the
67# severity level should not affect the number of polices because we've
68# turned them all off in the config file.
59b05e08 69
bd313feb
CD
70SKIP:
71{
bd313feb
CD
72 $profile = "$samples_dir/perlcriticrc.none";
73 for my $severity (undef, $SEVERITY_LOWEST .. $SEVERITY_HIGHEST) {
74 my $c = Perl::Critic->new( -profile => $profile, -severity => $severity);
faa35de4 75 is_deeply( [$c->policies], [], 'no policies, severity '.($severity||'undef'));
bd313feb 76 }
9e2cb0fd 77}
1e7b8681 78
9e2cb0fd
JRT
79#--------------------------------------------------------------
80# Test config w/ multiple severity levels. In this config, we've
81# defined an arbitrary severity for each Policy so that severity
82# levels 5 through 2 each have 10 Policies. All remaining Policies
83# are in the 1st severity level.
84
dc93df4f 85
8fc09ae2 86{
dc93df4f
JRT
87 my $last_policy_count = 0;
88 my $profile = "$samples_dir/perlcriticrc.levels";
89
8fc09ae2 90 for my $severity ( reverse $SEVERITY_LOWEST+1 .. $SEVERITY_HIGHEST ) {
dc93df4f
JRT
91 my $c = Perl::Critic->new( -profile => $profile, -severity => $severity);
92 my $policy_count = scalar $c->policies();
8fc09ae2
CD
93 is( $policy_count, ($SEVERITY_HIGHEST - $severity + 1) * 10, 'severity levels' );
94 }
9e2cb0fd 95
dc93df4f
JRT
96 my $c = Perl::Critic->new( -profile => $profile, -severity => $SEVERITY_LOWEST);
97 my $policy_count = scalar $c->policies();
bd313feb 98 cmp_ok( $policy_count, '>=', ($SEVERITY_HIGHEST * 10), 'count highest severity');
9e2cb0fd 99}
59b05e08
JRT
100
101#--------------------------------------------------------------
59b05e08
JRT
102#Test pattern matching
103
104my (@in, @ex) = ();
faa35de4 105my @pols = ();
c5d8050b 106my $pc = undef;
59b05e08
JRT
107my $matches = 0;
108
c5d8050b
JRT
109# In this test, we'll use a cusotm profile to deactivate some
110# policies, and then use the -include option to re-activate them. So
111# the net result is that we should still end up with the all the
112# policies.
113
114my %profile = (
115 '-NamingConventions::ProhibitMixedCaseVars' => {},
116 '-NamingConventions::ProhibitMixedCaseSubs' => {},
117 '-Miscellanea::RequireRcsKeywords' => {},
118);
119
120@in = qw(mixedcase RCS);
faa35de4
JRT
121my %pc_config = (-severity => 1, -profile => \%profile, -include => \@in);
122@pols = Perl::Critic->new( %pc_config )->policies();
123is(scalar @pols, $total_policies, 'pattern matching');
c5d8050b 124
faa35de4 125#--------------------------------------------------------------
c5d8050b
JRT
126
127# For this test, we'll load the default config, but deactivate some of
128# the policies using the -exclude option. Then we make sure that none
129# of the remaining policies match the -exclude patterns.
59b05e08
JRT
130
131@ex = qw(quote mixed VALUES); #Some assorted pattterns
faa35de4
JRT
132@pols = Perl::Critic->new( -severity => 1, -exclude => \@ex )->policies();
133$matches = grep { my $pol = ref $_; grep { $pol !~ /$_/imx} @ex } @pols;
134is(scalar @pols, $matches, 'pattern matching');
59b05e08 135
c5d8050b
JRT
136# In this test, we set -include and -exclude patterns to both match
137# some of the same policies. The -exclude option should have
138# precendece.
139
bd313feb 140@in = qw(builtinfunc); #Include BuiltinFunctions::*
59b05e08 141@ex = qw(block); #Exclude RequireBlockGrep, RequireBlockMap
faa35de4
JRT
142@pols = Perl::Critic->new( -severity => 1, -include => \@in, -exclude => \@ex )->policies();
143my @pol_names = map {ref $_} @pols;
bd313feb
CD
144is_deeply( [grep {/block/imx} @pol_names], [], 'pattern match' );
145# This odd construct arises because "any" can't be used with parens without syntax error(!)
146ok( @{[any {/builtinfunc/imx} @pol_names]}, 'pattern match' );
59b05e08 147
b874170a 148#--------------------------------------------------------------
dc93df4f 149# Test exception handling
faa35de4
JRT
150
151{
dc93df4f 152 #Trap warnings here.
bd0b9365
JRT
153 my $caught_warning = q{};
154 local $SIG{__WARN__} = sub { $caught_warning = shift };
dc93df4f 155 my $config = Perl::Critic::Config->new();
bd0b9365 156
dc93df4f
JRT
157 # Try loading a bogus policy
158 my $returned = $config->add_policy( -policy => 'Bogus::Policy');
159 ok( !defined $returned );
160 ok( $caught_warning );
161 $caught_warning = q{}; #Reset
162
163 # Try loading from bogus namespace
bd0b9365
JRT
164 Perl::Critic::Config->import( -namespace => 'Bogus::Namespace' );
165 ok( $caught_warning );
dc93df4f 166 $caught_warning = q{}; #Reset
bd0b9365
JRT
167}
168