File Coverage

blib/lib/Perl/Lint/Policy/CodeLayout/ProhibitParensWithBuiltins.pm
Criterion Covered Total %
statement 54 56 96.4
branch 27 28 96.4
condition 11 15 73.3
subroutine 7 7 100.0
pod 0 1 0.0
total 99 107 92.5


line stmt bran cond sub pod time code
1             package Perl::Lint::Policy::CodeLayout::ProhibitParensWithBuiltins;
2 134     134   104506 use strict;
  134         361  
  134         5323  
3 134     134   606 use warnings;
  134         297  
  134         4558  
4 134     134   1162 use Perl::Lint::Constants::Type;
  134         214  
  134         87026  
5 134     134   48537 use Perl::Lint::Constants::Kind;
  134         275  
  134         9478  
6 134     134   728 use parent "Perl::Lint::Policy";
  134         228  
  134         585  
7              
8             use constant {
9 134         71117 DESC => 'Builtin function called with parentheses',
10             EXPL => [13],
11 134     134   8186 };
  134         227  
12              
13             my %named_unary_ops = (
14             alarm => 1,
15             glob => 1,
16             rand => 1,
17             caller => 1,
18             gmtime => 1,
19             readlink => 1,
20             chdir => 1,
21             hex => 1,
22             ref => 1,
23             chroot => 1,
24             int => 1,
25             require => 1,
26             cos => 1,
27             lc => 1,
28             return => 1,
29             defined => 1,
30             lcfirst => 1,
31             rmdir => 1,
32             delete => 1,
33             length => 1,
34             scalar => 1,
35             do => 1,
36             localtime => 1,
37             sin => 1,
38             eval => 1,
39             lock => 1,
40             sleep => 1,
41             exists => 1,
42             log => 1,
43             sqrt => 1,
44             exit => 1,
45             lstat => 1,
46             srand => 1,
47             getgrp => 1,
48             my => 1,
49             stat => 1,
50             gethostbyname => 1,
51             oct => 1,
52             uc => 1,
53             getnetbyname => 1,
54             ord => 1,
55             ucfirst => 1,
56             getprotobyname => 1,
57             quotemeta => 1,
58             umask => 1,
59             undef => 1,
60             sort => 1,
61             );
62              
63             sub evaluate {
64 15     15 0 42 my ($class, $file, $tokens, $src, $args) = @_;
65              
66 15         19 my @violations;
67 15         56 for (my $i = 0; my $token = $tokens->[$i]; $i++) {
68 362         326 my $token_type = $token->{type};
69              
70 362 100       890 if ($token_type == BUILTIN_FUNC) {
71 46         57 my $func = $token->{data};
72              
73 46         53 $token = $tokens->[++$i];
74 46 100       138 if ($token->{type} == LEFT_PAREN) {
75             # for unary operators with parens
76 36 100       73 if ($named_unary_ops{$func}) {
77 20         24 $token = $tokens->[++$i];
78              
79 20 100       36 if ($token->{type} == RIGHT_PAREN) { # no args
80 3         8 push @violations, {
81             filename => $file,
82             line => $token->{line},
83             description => DESC,
84             explanation => EXPL,
85             policy => __PACKAGE__,
86             };
87 3         8 next;
88             }
89              
90 17         21 my $left_paren_num = 1;
91 17         35 for (; my $token = $tokens->[$i]; $i++) {
92 56         59 my $token_type = $token->{type};
93              
94 56 100       147 if ($token_type == LEFT_PAREN) {
    100          
    50          
95 3         10 $left_paren_num++;
96             }
97             elsif ($token_type == RIGHT_PAREN) {
98 20 100       45 last if --$left_paren_num <= 0;
99             }
100             elsif ($token_type == COMMA) {
101 0         0 push @violations, {
102             filename => $file,
103             line => $token->{line},
104             description => DESC,
105             explanation => EXPL,
106             policy => __PACKAGE__,
107             };
108 0         0 last;
109             }
110             }
111 17         42 next;
112             }
113              
114 16         18 my $is_op_in_arg = 0;
115 16         13 my $left_paren_num = 1;
116 16         36 for ($i++; my $token = $tokens->[$i]; $i++) {
117 113         108 my $token_type = $token->{type};
118              
119 113 100 66     461 if ($token_type == LEFT_PAREN) {
    100          
    100          
120 7         15 $left_paren_num++;
121             }
122             elsif ($token_type == RIGHT_PAREN) {
123 23 100       52 last if --$left_paren_num <= 0;
124             }
125             elsif ($token_type == ASSIGN || $token->{kind} == KIND_OP) {
126 1         3 $is_op_in_arg = 1;
127             }
128             }
129              
130 16 100       31 if ($is_op_in_arg) {
131 1         4 next;
132             }
133              
134 15         18 $token = $tokens->[++$i];
135 15         21 my $token_data = $token->{data};
136 15 100 100     102 if (
      100        
      66        
      33        
137             $token->{type} == COMMA ||
138             (
139             $token->{kind} == KIND_OP &&
140             $token_data ne 'and' && # XXX enough?
141             $token_data ne 'or' && # for low-precedence operator
142             $token_data ne 'xor' #
143             )
144             ) {
145 5         13 next;
146             }
147              
148 10         58 push @violations, {
149             filename => $file,
150             line => $token->{line},
151             description => DESC,
152             explanation => EXPL,
153             policy => __PACKAGE__,
154             };
155             }
156             }
157             }
158              
159 15         166 return \@violations;
160             }
161              
162             1;