From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

ELLIOTJS / Perl-Critic-1.083_005 / t / 14_policy_parameters.t 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127

              
#!perl
##############################################################################
#      $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/t/14_policy_parameters.t $
#     $Date: 2008-03-16 17:40:45 -0500 (Sun, 16 Mar 2008) $
#   $Author: clonezone $
# $Revision: 2187 $
##############################################################################
use strict;
use warnings;
use English qw(-no_match_vars);
use Perl::Critic::UserProfile qw();
use Perl::Critic::PolicyFactory (-test => 1);
use Perl::Critic::PolicyParameter qw{ $NO_DESCRIPTION_AVAILABLE };
use Perl::Critic::Utils qw( policy_short_name );
use Perl::Critic::TestUtils qw(bundled_policy_names);
use Test::More; #plan set below!
Perl::Critic::TestUtils::block_perlcriticrc();
#-----------------------------------------------------------------------------
# This script proves that each policy that ships with Perl::Critic overrides
# the supported_parameters() method and, assuming that the policy is
# configurable, that each parameter can parse its own default_string.
#
# This script also verifies that Perl::Critic::PolicyFactory throws an
# exception when we try to create a policy with bogus parameters.  However, it
# is your responsibility to verify that valid parameters actually work as
# expected.  You can do this by using the #parms directive in the *.run files.
#-----------------------------------------------------------------------------
# Figure out how many tests there will be...
my @all_policies = bundled_policy_names();
my @all_params   = map { $_->supported_parameters() } @all_policies;
my $ntests       = @all_policies + 2 * @all_params;
plan( tests => $ntests );
#-----------------------------------------------------------------------------
for my $policy ( @all_policies ) {
    test_has_declared_parameters( $policy );
    test_invalid_parameters( $policy );
    test_supported_parameters( $policy );
}
#-----------------------------------------------------------------------------
sub test_supported_parameters {
    my $policy_name = shift;
    my @supported_params = $policy_name->supported_parameters();
    my $config = Perl::Critic::Config->new( -profile => 'NONE' );
    for my $param_specification ( @supported_params ) {
        my $parameter =
            Perl::Critic::PolicyParameter->new($param_specification);
        my $param_name = $parameter->get_name();
        my $description = $parameter->get_description();
        ok(
            $description && $description ne $NO_DESCRIPTION_AVAILABLE,
            qq{Param "$param_name" for policy "$policy_name" has a description},
        );
        my %args = (
            -policy => $policy_name,
            -params => {
                 $param_name => $parameter->get_default_string(),
            }
        );
        eval { $config->add_policy( %args ) };
        is(
            $EVAL_ERROR,
            q{},
            qq{Created policy "$policy_name" with param "$param_name"},
        );
    }
}
#-----------------------------------------------------------------------------
sub test_invalid_parameters {
    my $policy = shift;
    my $bogus_params  = { bogus => 'shizzle' };
    my $profile = Perl::Critic::UserProfile->new( -profile => 'NONE' );
    my $factory = Perl::Critic::PolicyFactory->new( -profile => $profile );
    my $policy_name = policy_short_name($policy);
    my $label = qq{Created $policy_name with bogus parameters};
    eval { $factory->create_policy(-name => $policy, -params => $bogus_params) };
    like(
        $EVAL_ERROR,
        qr/The $policy_name policy doesn't take a "bogus" option/,
        $label
    );
}
#-----------------------------------------------------------------------------
sub test_has_declared_parameters {
    my $policy = shift;
    if ( not $policy->can('supported_parameters') ) {
        fail( qq{I don't know if $policy supports params} );
        diag( qq{This means $policy needs a supported_parameters() method} );
        return;
    }
}
#-----------------------------------------------------------------------------
# ensure we run true if this test is loaded by
# t/14_policy_parameters.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 :