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

   1 #!perl
   2
   3 ##############################################################################
   4 #      $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/t/14_policy_parameters.t $
   5 #     $Date: 2008-06-06 00:48:04 -0500 (Fri, 06 Jun 2008) $
   6 #   $Author: clonezone $
   7 # $Revision: 2416 $
   8 ##############################################################################
   9
  10 use 5.006001;
  11 use strict;
  12 use warnings;
  13
  14 use English qw(-no_match_vars);
  15
  16 use Perl::Critic::UserProfile qw();
  17 use Perl::Critic::PolicyFactory (-test => 1);
  18 use Perl::Critic::PolicyParameter qw{ $NO_DESCRIPTION_AVAILABLE };
  19 use Perl::Critic::Utils qw( policy_short_name );
  20 use Perl::Critic::TestUtils qw(bundled_policy_names);
  21
  22 use Test::More; #plan set below!
  23
  24 Perl::Critic::TestUtils::block_perlcriticrc();
  25
  26 #-----------------------------------------------------------------------------
  27 # This script proves that each policy that ships with Perl::Critic overrides
  28 # the supported_parameters() method and, assuming that the policy is
  29 # configurable, that each parameter can parse its own default_string.
  30 #
  31 # This script also verifies that Perl::Critic::PolicyFactory throws an
  32 # exception when we try to create a policy with bogus parameters.  However, it
  33 # is your responsibility to verify that valid parameters actually work as
  34 # expected.  You can do this by using the #parms directive in the *.run files.
  35 #-----------------------------------------------------------------------------
  36
  37 # Figure out how many tests there will be...
  38 my @all_policies = bundled_policy_names();
  39 my @all_params   = map { $_->supported_parameters() } @all_policies;
  40 my $ntests       = @all_policies + 2 * @all_params;
  41 plan( tests => $ntests );
  42
  43 #-----------------------------------------------------------------------------
  44
  45 for my $policy ( @all_policies ) {
  46     test_has_declared_parameters( $policy );
  47     test_invalid_parameters( $policy );
  48     test_supported_parameters( $policy );
  49 }
  50
  51 #-----------------------------------------------------------------------------
  52
  53 sub test_supported_parameters {
  54     my $policy_name = shift;
  55     my @supported_params = $policy_name->supported_parameters();
  56     my $config = Perl::Critic::Config->new( -profile => 'NONE' );
  57
  58     for my $param_specification ( @supported_params ) {
  59         my $parameter =
  60             Perl::Critic::PolicyParameter->new($param_specification);
  61         my $param_name = $parameter->get_name();
  62         my $description = $parameter->get_description();
  63
  64         ok(
  65             $description && $description ne $NO_DESCRIPTION_AVAILABLE,
  66             qq{Param "$param_name" for policy "$policy_name" has a description},
  67         );
  68
  69         my %args = (
  70             -policy => $policy_name,
  71             -params => {
  72                  $param_name => $parameter->get_default_string(),
  73             }
  74         );
  75         eval { $config->add_policy( %args ) };
  76         is(
  77             $EVAL_ERROR,
  78             q{},
  79             qq{Created policy "$policy_name" with param "$param_name"},
  80         );
  81     }
  82
  83     return;
  84 }
  85
  86 #-----------------------------------------------------------------------------
  87
  88 sub test_invalid_parameters {
  89     my $policy = shift;
  90     my $bogus_params  = { bogus => 'shizzle' };
  91     my $profile = Perl::Critic::UserProfile->new( -profile => 'NONE' );
  92     my $factory = Perl::Critic::PolicyFactory->new( -profile => $profile );
  93
  94     my $policy_name = policy_short_name($policy);
  95     my $label = qq{Created $policy_name with bogus parameters};
  96
  97     eval { $factory->create_policy(-name => $policy, -params => $bogus_params) };
  98     like(
  99         $EVAL_ERROR,
 100         qr/The $policy_name policy doesn't take a "bogus" option/,
 101         $label
 102     );
 103 }
 104
 105 #-----------------------------------------------------------------------------
 106
 107 sub test_has_declared_parameters {
 108     my $policy = shift;
 109     if ( not $policy->can('supported_parameters') ) {
 110         fail( qq{I don't know if $policy supports params} );
 111         diag( qq{This means $policy needs a supported_parameters() method} );
 112     }
 113     return;
 114 }
 115
 116 #-----------------------------------------------------------------------------
 117
 118 # ensure we run true if this test is loaded by
 119 # t/14_policy_parameters.t_without_optional_dependencies.t
 120 1;
 121
 122 ###############################################################################
 123 # Local Variables:
 124 #   mode: cperl
 125 #   cperl-indent-level: 4
 126 #   fill-column: 78
 127 #   indent-tabs-mode: nil
 128 #   c-indentation-style: bsd
 129 # End:
 130 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :