File Coverage

blib/lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitSingleArgArraySlice.pm
Criterion Covered Total %
statement 29 31 93.5
branch 8 10 80.0
condition n/a
subroutine 10 11 90.9
pod 4 5 80.0
total 51 57 89.4


line stmt bran cond sub pod time code
1             package Perl::Critic::Policy::ValuesAndExpressions::ProhibitSingleArgArraySlice;
2             our $AUTHORITY = 'cpan:XSAWYERX';
3             # ABSTRACT: Prohibit using an array slice with only one index
4              
5 1     1   177540 use strict;
  1         2  
  1         22  
6 1     1   4 use warnings;
  1         1  
  1         22  
7              
8 1     1   3 use Perl::Critic::Utils qw(:severities :classification :ppi);
  1         1  
  1         48  
9 1     1   270 use parent 'Perl::Critic::Policy';
  1         0  
  1         8  
10              
11             our $VERSION = '0.001';
12              
13 1     1   11845 use constant 'DESC' => 'Single argument to array slice';
  1         2  
  1         66  
14 1         147 use constant 'EXPL' => 'Using an array slice returns a list, '
15             . 'even when accessing a single value. '
16             . 'Instead, please rewrite this as a a '
17 1     1   3 . 'single value access, not array slice.';
  1         1  
18              
19 2     2 0 10670 sub supported_parameters { () }
20 3     3 1 21 sub default_severity {$SEVERITY_HIGHEST}
21 0     0 1 0 sub default_themes {'bugs'}
22 2     2 1 11411 sub applies_to {'PPI::Token::Symbol'}
23              
24             # TODO Check for a function in the subscript? Strict mode?
25              
26             sub violates {
27 9     9 1 394 my ( $self, $elem ) = @_;
28 9 50       22 $elem->isa('PPI::Token::Symbol')
29             or return ();
30              
31 9 100       13 substr( "$elem", 0, 1 ) eq '@'
32             or return ();
33              
34 6         32 my $next = $elem->snext_sibling;
35 6 100       96 $next->isa('PPI::Structure::Subscript')
36             or return ();
37              
38 5         13 my @children = $next->children;
39 5 100       25 @children > 1
40             and return ();
41              
42 3 50       11 @children == 1
43             and return $self->violation( DESC(), EXPL(), $next );
44              
45 0           return $self->violation(
46             'Empty subscript',
47             'You have an array slice with an empty subscript',
48             $next,
49             );
50             }
51              
52             1;
53              
54             __END__
55              
56             =pod
57              
58             =encoding UTF-8
59              
60             =head1 NAME
61              
62             Perl::Critic::Policy::ValuesAndExpressions::ProhibitSingleArgArraySlice - Prohibit using an array slice with only one index
63              
64             =head1 VERSION
65              
66             version 0.002
67              
68             =head1 DESCRIPTION
69              
70             When using an array slice C<@foo[]>, you can retrieve multiple values by
71             giving more than one index. Sometimes, however, either due to typo or
72             inexperience, we might only provide a single index. This is a problem due
73             to the list context enforced.
74              
75             Perl warns you about this, but it will only do this during runtime. This
76             policy allows you to detect it statically.
77              
78             # scalar context, single value retrieved
79             my $one_value = $array[$index]; # ok
80              
81             # List context, multiple values retrieved
82             my @values = @array[ $index1, $index2 ] # ok
83              
84             # List context, single value retrived - the size of the array!
85             # Perl will warn you, but only in runtime
86             my $value = @array[$index]; # not ok
87              
88             =head1 CONFIGURATION
89              
90             This policy is not configurable except for the standard options.
91              
92             =head1 SEE ALSO
93              
94             L<Perl::Critic>
95              
96             =head1 AUTHOR
97              
98             Sawyer X <xsawyerx@cpan.org>
99              
100             =head1 COPYRIGHT AND LICENSE
101              
102             This software is Copyright (c) 2016 by Sawyer X.
103              
104             This is free software, licensed under:
105              
106             The MIT (X11) License
107              
108             =cut