#!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 :