--- /dev/null
+#!perl
+
+##############################################################################
+# $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/t/01_config.t $
+# $Date: 2008-06-21 19:57:54 -0700 (Sat, 21 Jun 2008) $
+# $Author: clonezone $
+# $Revision: 2464 $
+##############################################################################
+
+use 5.006001;
+use strict;
+use warnings;
+
+use English qw< -no_match_vars >;
+
+use File::Spec;
+use List::MoreUtils qw(all any);
+
+use Perl::Critic::Exception::AggregateConfiguration;
+use Perl::Critic::Config qw<>;
+use Perl::Critic::PolicyFactory (-test => 1);
+use Perl::Critic::TestUtils qw<
+ bundled_policy_names
+ names_of_policies_willing_to_work
+>;
+use Perl::Critic::Utils qw< :severities >;
+
+use Test::More tests => 66;
+
+
+Perl::Critic::TestUtils::block_perlcriticrc();
+
+#-----------------------------------------------------------------------------
+
+my @names_of_policies_willing_to_work =
+ names_of_policies_willing_to_work(
+ -severity => $SEVERITY_LOWEST,
+ -theme => 'core',
+ );
+my @native_policy_names = bundled_policy_names();
+my $total_policies = scalar @names_of_policies_willing_to_work;
+
+#-----------------------------------------------------------------------------
+# Test default config. Increasing the severity should yield
+# fewer and fewer policies. The exact number will fluctuate
+# as we introduce new polices and/or change their severity.
+
+{
+ my $last_policy_count = $total_policies + 1;
+ for my $severity ($SEVERITY_LOWEST .. $SEVERITY_HIGHEST) {
+ my $configuration =
+ Perl::Critic::Config->new(
+ -severity => $severity,
+ -theme => 'core',
+ );
+ my $policy_count = scalar $configuration->policies();
+ my $test_name = "Count native policies, severity: $severity";
+ cmp_ok($policy_count, '<', $last_policy_count, $test_name);
+ $last_policy_count = $policy_count;
+ }
+}
+
+
+#-----------------------------------------------------------------------------
+# Same tests as above, but using a generated config
+
+{
+ my %profile = map { $_ => {} } @native_policy_names;
+ my $last_policy_count = $total_policies + 1;
+ for my $severity ($SEVERITY_LOWEST .. $SEVERITY_HIGHEST) {
+ my %pc_args = (
+ -profile => \%profile,
+ -severity => $severity,
+ -theme => 'core',
+ );
+ my $critic = Perl::Critic::Config->new( %pc_args );
+ my $policy_count = scalar $critic->policies();
+ my $test_name = "Count all policies, severity: $severity";
+ cmp_ok($policy_count, '<', $last_policy_count, $test_name);
+ $last_policy_count = $policy_count;
+ }
+}
+
+#-----------------------------------------------------------------------------
+# Test all-off config w/ various severity levels. In this case, the
+# severity level should not affect the number of polices because we've
+# turned them all off in the profile.
+
+#{
+# my %profile = map { '-' . $_ => {} } @native_policy_names;
+# for my $severity (undef, $SEVERITY_LOWEST .. $SEVERITY_HIGHEST) {
+# my $severity_string = $severity ? $severity : '<undef>';
+# my %pc_args = (
+# -profile => \%profile,
+# -severity => $severity,
+# -theme => 'core',
+# );
+#
+# eval {
+# Perl::Critic::Config->new( %pc_args )->policies();
+# };
+# my $exception = Perl::Critic::Exception::AggregateConfiguration->caught();
+# ok(
+# defined $exception,
+# "got exception when no policies were enabled at severity $severity_string.",
+# );
+# like(
+# $exception,
+# qr<There are no enabled policies>,
+# "got correct exception message when no policies were enabled at severity $severity_string.",
+# );
+# }
+#}
+
+#-----------------------------------------------------------------------------
+# Test config w/ multiple severity levels. In this profile, we
+# define an arbitrary severity for each Policy so that severity
+# levels 5 through 2 each have 10 Policies. All remaining Policies
+# are in the 1st severity level.
+
+
+{
+ my %profile = ();
+ my $last_policy_count = 0;
+ my $severity = $SEVERITY_HIGHEST;
+ for my $index ( 0 .. $#names_of_policies_willing_to_work ) {
+ $severity-- if $index && $index % 10 == 0;
+ $severity = $SEVERITY_LOWEST if $severity < $SEVERITY_LOWEST;
+ $profile{$names_of_policies_willing_to_work[$index]} =
+ {severity => $severity};
+ }
+
+ for my $severity ( reverse $SEVERITY_LOWEST+1 .. $SEVERITY_HIGHEST ) {
+ my %pc_args = (
+ -profile => \%profile,
+ -severity => $severity,
+ -theme => 'core',
+ );
+ my $critic = Perl::Critic::Config->new( %pc_args );
+ my $policy_count = scalar $critic->policies();
+ my $expected_count = ($SEVERITY_HIGHEST - $severity + 1) * 10;
+ my $test_name = "user-defined severity level: $severity";
+ is( $policy_count, $expected_count, $test_name );
+ }
+
+ # All remaining policies should be at the lowest severity
+ my %pc_args = (-profile => \%profile, -severity => $SEVERITY_LOWEST);
+ my $critic = Perl::Critic::Config->new( %pc_args );
+ my $policy_count = scalar $critic->policies();
+ my $expected_count = $SEVERITY_HIGHEST * 10;
+ my $test_name = "user-defined severity, all remaining policies";
+ cmp_ok( $policy_count, '>=', $expected_count, $test_name);
+}
+
+#-----------------------------------------------------------------------------
+# Test config with defaults
+
+{
+ my $examples_dir = 'examples';
+ my $profile = File::Spec->catfile( $examples_dir, 'perlcriticrc' );
+ my $c = Perl::Critic::Config->new( -profile => $profile );
+
+ is_deeply([$c->exclude()], [ qw(Documentation Naming) ],
+ 'user default exclude from file' );
+
+ is_deeply([$c->include()], [ qw(CodeLayout Modules) ],
+ 'user default include from file' );
+
+ is($c->force(), 1, 'user default force from file' );
+ is($c->only(), 1, 'user default only from file' );
+ is($c->severity(), 3, 'user default severity from file' );
+ is($c->theme()->rule(), 'danger || risky && ! pbp', 'user default theme from file');
+ is($c->top(), 50, 'user default top from file' );
+ is($c->verbose(), 5, 'user default verbose from file' );
+}
+
+#-----------------------------------------------------------------------------
+#Test pattern matching
+
+
+{
+ # In this test, we'll use a cusotm profile to deactivate some
+ # policies, and then use the -include option to re-activate them. So
+ # the net result is that we should still end up with the all the
+ # policies.
+
+ my %profile = (
+ '-NamingConventions::ProhibitMixedCaseVars' => {},
+ '-NamingConventions::ProhibitMixedCaseSubs' => {},
+ '-Miscellanea::RequireRcsKeywords' => {},
+ );
+
+ my @include = qw(mixedcase RCS);
+ my %pc_args = (
+ -profile => \%profile,
+ -severity => 1,
+ -include => \@include,
+ -theme => 'core',
+ );
+ my @policies = Perl::Critic::Config->new( %pc_args )->policies();
+ is(scalar @policies, $total_policies, 'include pattern matching');
+}
+
+#-----------------------------------------------------------------------------
+
+{
+ # For this test, we'll load the default config, but deactivate some of
+ # the policies using the -exclude option. Then we make sure that none
+ # of the remaining policies match the -exclude patterns.
+
+ my @exclude = qw(quote mixed VALUES); #Some assorted pattterns
+ my %pc_args = (
+ -severity => 1,
+ -exclude => \@exclude,
+ );
+ my @policies = Perl::Critic::Config->new( %pc_args )->policies();
+ my $matches = grep { my $pol = ref $_; grep { $pol !~ /$_/imx} @exclude } @policies;
+ is(scalar @policies, $matches, 'exclude pattern matching');
+}
+
+#-----------------------------------------------------------------------------
+
+{
+ # In this test, we set -include and -exclude patterns to both match
+ # some of the same policies. The -exclude option should have
+ # precendece.
+
+ my @include = qw(builtinfunc); #Include BuiltinFunctions::*
+ my @exclude = qw(block); #Exclude RequireBlockGrep, RequireBlockMap
+ my %pc_args = (
+ -severity => 1,
+ -include => \@include,
+ -exclude => \@exclude,
+ );
+ my @policies = Perl::Critic::Config->new( %pc_args )->policies();
+ my @pol_names = map {ref $_} @policies;
+ is_deeply(
+ [grep {/block/imx} @pol_names],
+ [],
+ 'include/exclude pattern match had no "block" policies',
+ );
+ # This odd construct arises because "any" can't be used with parens without syntax error(!)
+ ok(
+ @{[any {/builtinfunc/imx} @pol_names]},
+ 'include/exclude pattern match had "builtinfunc" policies',
+ );
+}
+
+#-----------------------------------------------------------------------------
+# Test the switch behavior
+
+{
+ my @switches = qw(
+ -top
+ -verbose
+ -theme
+ -severity
+ -only
+ -force
+ -color
+ -criticism-fatal
+ );
+
+ my %undef_args = map { $_ => undef } @switches;
+ my $c = Perl::Critic::Config->new( %undef_args );
+ $c = Perl::Critic::Config->new( %undef_args );
+ is( $c->force(), 0, 'Undefined -force');
+ is( $c->only(), 0, 'Undefined -only');
+ is( $c->severity(), 5, 'Undefined -severity');
+ is( $c->theme()->rule(), q{}, 'Undefined -theme');
+ is( $c->top(), 0, 'Undefined -top');
+ is( $c->color(), 1, 'Undefined -color');
+ is( $c->verbose(), 4, 'Undefined -verbose');
+ is( $c->criticism_fatal(), 0, 'Undefined -criticism-fatal');
+
+ my %zero_args = map { $_ => 0 } @switches;
+ $c = Perl::Critic::Config->new( %zero_args );
+ is( $c->force(), 0, 'zero -force');
+ is( $c->only(), 0, 'zero -only');
+ is( $c->severity(), 1, 'zero -severity');
+ is( $c->theme()->rule(), q{}, 'zero -theme');
+ is( $c->top(), 0, 'zero -top');
+ is( $c->color(), 0, 'zero -color');
+ is( $c->verbose(), 4, 'zero -verbose');
+ is( $c->criticism_fatal(), 0, 'zero -criticism-fatal');
+
+ my %empty_args = map { $_ => q{} } @switches;
+ $c = Perl::Critic::Config->new( %empty_args );
+ is( $c->force(), 0, 'empty -force');
+ is( $c->only(), 0, 'empty -only');
+ is( $c->severity(), 1, 'empty -severity');
+ is( $c->theme->rule(), q{}, 'empty -theme');
+ is( $c->top(), 0, 'empty -top');
+ is( $c->color(), 0, 'empty -color');
+ is( $c->verbose(), 4, 'empty -verbose');
+ is( $c->criticism_fatal(), 0, 'empty -criticism-fatal');
+}
+
+#-----------------------------------------------------------------------------
+# Test the -only switch
+
+{
+ my %profile = (
+ '-NamingConventions::ProhibitMixedCaseVars' => {},
+ 'NamingConventions::ProhibitMixedCaseSubs' => {},
+ 'Miscellanea::RequireRcsKeywords' => {},
+ );
+
+ my %pc_config = (-severity => 1, -only => 1, -profile => \%profile);
+ my @policies = Perl::Critic::Config->new( %pc_config )->policies();
+ is(scalar @policies, 2, '-only switch');
+
+# %pc_config = ( -severity => 1, -only => 1, -profile => {} );
+# eval { Perl::Critic::Config->new( %pc_config )->policies() };
+# my $exception = Perl::Critic::Exception::AggregateConfiguration->caught();
+# ok(
+# defined $exception,
+# "got exception with -only switch, empty profile.",
+# );
+# like(
+# $exception,
+# qr<There are no enabled policies>,
+# "got correct exception message with -only switch, empty profile.",
+# );
+}
+
+#-----------------------------------------------------------------------------
+# Test the -single-policy switch
+
+{
+ my %pc_config = ('-single-policy' => 'ProhibitEvilModules');
+ my @policies = Perl::Critic::Config->new( %pc_config )->policies();
+ is(scalar @policies, 1, '-single-policy switch');
+}
+
+#-----------------------------------------------------------------------------
+# Test interaction between switches and defaults
+
+{
+ my %true_defaults = ( force => 1, only => 1, top => 10 );
+ my %profile = ( '__defaults__' => \%true_defaults );
+
+ my %pc_config = (-force => 0, -only => 0, -top => 0, -profile => \%profile);
+ my $config = Perl::Critic::Config->new( %pc_config );
+ is( $config->force, 0, '-force: default is true, arg is false');
+ is( $config->only, 0, '-only: default is true, arg is false');
+ is( $config->top, 0, '-top: default is true, arg is false');
+}
+
+#-----------------------------------------------------------------------------
+# Test named severity levels
+
+{
+ my %severity_levels = (gentle=>5, stern=>4, harsh=>3, cruel=>2, brutal=>1);
+ while (my ($name, $number) = each %severity_levels) {
+ my $config = Perl::Critic::Config->new( -severity => $name );
+ is( $config->severity(), $number, qq{Severity "$name" is "$number"});
+ }
+}
+
+
+#-----------------------------------------------------------------------------
+# Test exception handling
+
+{
+ my $config = Perl::Critic::Config->new( -profile => 'NONE' );
+
+ # Try adding a bogus policy
+ eval{ $config->add_policy( -policy => 'Bogus::Policy') };
+ like( $EVAL_ERROR, qr/Unable to create policy/, 'add_policy w/ bad args' );
+
+ # Try adding w/o policy
+ eval { $config->add_policy() };
+ like( $EVAL_ERROR, qr/The -policy argument is required/, 'add_policy w/o args' );
+
+ # Try using bogus named severity level
+ eval{ Perl::Critic::Config->new( -severity => 'bogus' ) };
+ like(
+ $EVAL_ERROR,
+ qr/The value for the global "-severity" option \("bogus"\) is not one of the valid severity names/,
+ 'invalid severity'
+ );
+
+ # Try using vague -single-policy option
+ eval{ Perl::Critic::Config->new( '-single-policy' => '.*' ) };
+ like( $EVAL_ERROR, qr/matched multiple policies/, 'vague -single-policy' );
+
+ # Try using invalid -single-policy option
+ eval{ Perl::Critic::Config->new( '-single-policy' => 'bogus' ) };
+ like( $EVAL_ERROR, qr/did not match any policies/, 'invalid -single-policy' );
+}
+
+#-----------------------------------------------------------------------------
+
+# ensure we run true if this test is loaded by
+# t/01_config.t_without_optional_dependencies.t
+1;
+
+##############################################################################
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 78
+# indent-tabs-mode: nil
+# c-indentation-style: bsd
+# End:
+# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
projects / dh-make-perl / blobdiff