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

   1 #!perl
   2
   3 ##############################################################################
   4 #      $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/t/01_config_bad_perlcriticrc.t $
   5 #     $Date: 2008-06-21 19:57:54 -0700 (Sat, 21 Jun 2008) $
   6 #   $Author: clonezone $
   7 # $Revision: 2464 $
   8 ##############################################################################
   9
  10
  11 # Test that all the problems in an rc file get reported and not just the first
  12 # one that is found.
  13
  14
  15 use 5.006001;
  16 use strict;
  17 use warnings;
  18
  19 use English qw< -no_match_vars >;
  20 use Readonly;
  21
  22 use Test::More;
  23
  24 use Perl::Critic::PolicyFactory (-test => 1);
  25 use Perl::Critic;
  26
  27 plan tests => 13;
  28
  29 Readonly::Scalar my $PROFILE => 't/01_bad_perlcriticrc';
  30 Readonly::Scalar my $NO_ENABLED_POLICIES_MESSAGE =>
  31     q<There are no enabled policies.>;
  32 Readonly::Scalar my $INVALID_PARAMETER_MESSAGE =>
  33     q<The BuiltinFunctions::RequireBlockGrep policy doesn't take a "no_such_parameter" option.>;
  34 Readonly::Scalar my $REQUIRE_POD_SECTIONS_SOURCE_MESSAGE_PREFIX =>
  35     q<The value for the Documentation::RequirePodSections "source" option ("Zen_and_the_Art_of_Motorcycle_Maintenance") is not one of the allowed values: >;
  36
  37 eval {
  38     my $critic = Perl::Critic->new( '-profile' => $PROFILE );
  39 };
  40
  41 my $test_passed;
  42 my $eval_result = $EVAL_ERROR;
  43
  44 $test_passed =
  45     ok( $eval_result, 'should get an exception when using a bad rc file' );
  46
  47 die "No point in continuing.\n" if not $test_passed;
  48
  49 $test_passed =
  50     isa_ok(
  51         $eval_result,
  52         'Perl::Critic::Exception::AggregateConfiguration',
  53         '$EVAL_ERROR',
  54     );
  55
  56 if ( not $test_passed ) {
  57     diag( $eval_result );
  58     die "No point in continuing.\n";
  59 }
  60
  61 my @exceptions = @{ $eval_result->exceptions() };
  62
  63 my @parameters = qw<
  64     exclude
  65     include
  66     profile-strictness
  67     severity
  68     single-policy
  69     theme
  70     top
  71     verbose
  72 >;
  73
  74 my %expected_regexes =
  75     map
  76         { $_ => generate_global_message_regex( $_, $PROFILE ) }
  77         @parameters;
  78
  79 my $expected_exceptions = 2 + scalar @parameters;
  80 is(
  81     scalar @exceptions,
  82     $expected_exceptions,
  83     'should have received the correct number of exceptions'
  84 );
  85 if (@exceptions != $expected_exceptions) {
  86     diag "Exception: $_" foreach @exceptions;
  87 }
  88
  89 while (my ($parameter, $regex) = each %expected_regexes) {
  90     is(
  91         ( scalar grep { m/$regex/ } @exceptions ),
  92         1,
  93         "should have received one and only one exception for $parameter",
  94     );
  95 }
  96
  97 is(
  98     ( scalar grep { $INVALID_PARAMETER_MESSAGE eq $_ } @exceptions ),
  99     1,
 100     "should have received an extra-parameter exception",
 101 );
 102
 103 # Test that we get an exception for bad individual policy configuration.
 104 # The selection of RequirePodSections is arbitrary.
 105 is(
 106     ( scalar grep { is_require_pod_sections_source_exception($_) } @exceptions ),
 107     1,
 108     "should have received an invalid source exception for RequirePodSections",
 109 );
 110
 111 sub generate_global_message_regex {
 112     my ($parameter, $file) = @_;
 113
 114     return
 115         qr/
 116             \A
 117             The [ ] value [ ] for [ ] the [ ] global [ ]
 118             "$parameter"
 119             .*
 120             found [ ] in [ ] "$file"
 121         /xms;
 122 }
 123
 124 sub is_require_pod_sections_source_exception {
 125     my ($exception) = @_;
 126
 127     my $prefix =
 128         substr
 129             $exception,
 130             0,
 131             length $REQUIRE_POD_SECTIONS_SOURCE_MESSAGE_PREFIX;
 132
 133     return $prefix eq $REQUIRE_POD_SECTIONS_SOURCE_MESSAGE_PREFIX;
 134 }
 135
 136 #-----------------------------------------------------------------------------
 137
 138 # ensure we run true if this test is loaded by
 139 # t/01_config_bad_perlcriticrc.t_without_optional_dependencies.t
 140 1;
 141
 142
 143 ##############################################################################
 144 # Local Variables:
 145 #   mode: cperl
 146 #   cperl-indent-level: 4
 147 #   fill-column: 78
 148 #   indent-tabs-mode: nil
 149 #   c-indentation-style: bsd
 150 # End:
 151 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :