File Coverage

blib/lib/Perl/Critic/Policy/TestingAndDebugging/RequireTestLabels.pm
Criterion Covered Total %
statement 38 38 100.0
branch 9 10 90.0
condition n/a
subroutine 14 14 100.0
pod 4 5 80.0
total 65 67 97.0


line stmt bran cond sub pod time code
1             package Perl::Critic::Policy::TestingAndDebugging::RequireTestLabels;
2              
3 40     40   32344 use 5.010001;
  40         177  
4 40     40   338 use strict;
  40         140  
  40         983  
5 40     40   223 use warnings;
  40         99  
  40         1145  
6 40     40   227 use Readonly;
  40         102  
  40         2176  
7              
8 40     40   293 use List::SomeUtils qw(any);
  40         118  
  40         2162  
9 40         2007 use Perl::Critic::Utils qw{
10             :characters :severities :data_conversion :classification :ppi
11 40     40   267 };
  40         116  
12 40     40   22555 use parent 'Perl::Critic::Policy';
  40         120  
  40         235  
13              
14             our $VERSION = '1.146';
15              
16             Readonly::Hash my %LABEL_ARG_POS => (
17             ok => 1,
18             is => 2,
19             isnt => 2,
20             like => 2,
21             unlike => 2,
22             cmp_ok => 3,
23             is_deeply => 2,
24             pass => 0,
25             fail => 0,
26             );
27              
28             #-----------------------------------------------------------------------------
29              
30             Readonly::Scalar my $DESC => q{Test without a label};
31             Readonly::Scalar my $EXPL => q{Add a label argument to all Test::More functions};
32              
33             #-----------------------------------------------------------------------------
34              
35             sub supported_parameters {
36             return (
37             {
38 97     97 0 2201 name => 'modules',
39             description => 'The additional modules to require labels for.',
40             default_string => $EMPTY,
41             behavior => 'string list',
42             list_always_present_values => [ qw( Test::More ) ],
43             },
44             );
45             }
46              
47 87     87 1 367 sub default_severity { return $SEVERITY_MEDIUM }
48 74     74 1 374 sub default_themes { return qw( core maintenance tests ) }
49 37     37 1 134 sub applies_to { return 'PPI::Token::Word' }
50              
51             #-----------------------------------------------------------------------------
52              
53             sub violates {
54 386     386 1 838 my ($self, $elem, $doc) = @_;
55              
56 386         870 my $arg_index = $LABEL_ARG_POS{$elem};
57 386 100       5030 return if not defined $arg_index;
58 40 50       135 return if not is_function_call($elem);
59 40 100       139 return if not $self->_has_test_more($doc);
60              
61             # Does the function call have enough arguments?
62 25         878 my @args = parse_arg_list($elem);
63 25 100       107 return if ( @args > $arg_index );
64              
65 13         57 return $self->violation( $DESC, $EXPL, $elem );
66             }
67              
68             #-----------------------------------------------------------------------------
69              
70             sub _has_test_more {
71 40     40   97 my ( $self, $doc ) = @_;
72              
73             # TODO: This method gets called every time violates() is invoked,
74             # but it only needs to happen once per document. Perhaps this
75             # policy should just apply to PPI::Document, and then do its own
76             # search for method calls. Since Perl::Critic::Document is
77             # optimized, this should be pretty fast.
78              
79 40         135 my $includes = $doc->find('PPI::Statement::Include');
80 40 100       172 return if not $includes;
81 26     26   113 return any { exists $self->{_modules}->{$_->module()} }
82 26         103 @{ $includes };
  26         108  
83             }
84              
85             1;
86              
87             #-----------------------------------------------------------------------------
88              
89             __END__
90              
91             =pod
92              
93             =head1 NAME
94              
95             Perl::Critic::Policy::TestingAndDebugging::RequireTestLabels - Tests should all have labels.
96              
97              
98             =head1 AFFILIATION
99              
100             This Policy is part of the core L<Perl::Critic|Perl::Critic>
101             distribution.
102              
103              
104             =head1 DESCRIPTION
105              
106             Most Perl modules with regression tests use L<Test::More|Test::More>
107             as infrastructure for writing and running those tests. It has an
108             easy, procedural syntax for writing comparisons of results to
109             expectations.
110              
111             Most of the Test::More functions allow the programmer to add an
112             optional label that describes what each test is trying to judge. When
113             a test goes wrong, these labels are very useful for quickly
114             determining where the problem originated.
115              
116             This policy enforces that all Test::More functions have labels where
117             applicable. This only applies to code that has a C<use Test::More> or
118             C<require Test::More> declaration (see below to add more test modules
119             to the list).
120              
121              
122             =head1 CONFIGURATION
123              
124             A list of additional modules to require label parameters be passed to
125             their methods can be specified with the C<modules> option. The list
126             must consist of whitespace-delimited, fully-qualified module names.
127             For example:
128              
129             [TestingAndDebugging::RequireTestLabels]
130             modules = My::Test::SubClass Some::Other::Module
131              
132             The module list always implicitly includes L<Test::More|Test::More>.
133              
134              
135             =head1 AUTHOR
136              
137             Chris Dolan <cdolan@cpan.org>
138              
139              
140             =head1 COPYRIGHT
141              
142             Copyright (c) 2006-2021 Chris Dolan.
143              
144             This program is free software; you can redistribute it and/or modify
145             it under the same terms as Perl itself.
146              
147             =cut
148              
149             # Local Variables:
150             # mode: cperl
151             # cperl-indent-level: 4
152             # fill-column: 78
153             # indent-tabs-mode: nil
154             # c-indentation-style: bsd
155             # End:
156             # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :