git.maemo.org Git - pkg-perl/blob - deb-src/libperl-critic-perl/libperl-critic-perl-1.088/t/01_config.t

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