File Coverage

blib/lib/Perl/Lint/Policy/BuiltinFunctions/ProhibitLvalueSubstr.pm
Criterion Covered Total %
statement 39 40 97.5
branch 14 18 77.7
condition 2 3 66.6
subroutine 6 6 100.0
pod 0 1 0.0
total 61 68 89.7


line stmt bran cond sub pod time code
1             package Perl::Lint::Policy::BuiltinFunctions::ProhibitLvalueSubstr;
2 133     133   67887 use strict;
  133         179  
  133         3156  
3 133     133   403 use warnings;
  133         170  
  133         2473  
4 133     133   775 use Perl::Lint::Constants::Type;
  133         164  
  133         58410  
5 133     133   563 use parent "Perl::Lint::Policy";
  133         246  
  133         593  
6              
7             use constant {
8 133         35957 DESC => 'Lvalue form of "substr" used',
9             EXPL => [165],
10 133     133   6503 };
  133         209  
11              
12             sub evaluate {
13 8     8 0 11 my ($class, $file, $tokens, $src, $args) = @_;
14              
15 8         8 my @violations;
16 8         22 for (my $i = 0; my $token = $tokens->[$i]; $i++) {
17 56         34 my $token_type = $token->{type};
18 56         46 my $token_data = $token->{data};
19              
20 56 100 66     157 if ($token_type == BUILTIN_FUNC && $token_data eq 'substr') {
    100          
21 10         11 $token = $tokens->[++$i];
22 10 100       16 if ($token->{type} == LEFT_PAREN) {
23 8         8 my $left_paren_num = 1;
24 8         13 for ($i++; my $token = $tokens->[$i]; $i++) {
25 24         18 $token = $tokens->[++$i];
26 24         17 $token_type = $token->{type};
27              
28 24 50       51 if ($token_type == LEFT_PAREN) {
    100          
29 0         0 $left_paren_num++;
30             }
31             elsif ($token_type == RIGHT_PAREN) {
32 8 50       53 if (--$left_paren_num <= 0) {
33 8         7 my $next_token = $tokens->[++$i];
34 8 100       12 if ($next_token->{type} == ASSIGN) {
35             push @violations, {
36             filename => $file,
37             line => $token->{line},
38 6         19 description => DESC,
39             explanation => EXPL,
40             policy => __PACKAGE__,
41             };
42             }
43 8         17 last;
44             }
45             }
46             }
47             }
48             }
49             elsif ($token_type == USE_DECL) {
50 1         3 $token = $tokens->[++$i];
51 1 50       4 if ($token->{type} == DOUBLE) {
52 1         2 ($token_data = $token->{data}) =~ s/_//g;
53 1 50       5 if ($token_data <= 5.004) {
54 1         4 return [];
55             }
56             }
57             }
58             }
59              
60 7         23 return \@violations;
61             }
62              
63             1;
64