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   72988 use strict;
  134         177  
  134         3176  
3 134     134   430 use warnings;
  134         161  
  134         2495  
4 134     134   792 use Perl::Lint::Constants::Type;
  134         165  
  134         58844  
5 134     134   40110 use Perl::Lint::Constants::Kind;
  134         208  
  134         6846  
6 134     134   533 use parent "Perl::Lint::Policy";
  134         179  
  134         457  
7              
8             use constant {
9 134         52930 DESC => 'Builtin function called with parentheses',
10             EXPL => [13],
11 134     134   6607 };
  134         168  
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 22 my ($class, $file, $tokens, $src, $args) = @_;
65              
66 15         16 my @violations;
67 15         38 for (my $i = 0; my $token = $tokens->[$i]; $i++) {
68 362         295 my $token_type = $token->{type};
69              
70 362 100       613 if ($token_type == BUILTIN_FUNC) {
71 46         39 my $func = $token->{data};
72              
73 46         42 $token = $tokens->[++$i];
74 46 100       68 if ($token->{type} == LEFT_PAREN) {
75             # for unary operators with parens
76 36 100       51 if ($named_unary_ops{$func}) {
77 20         23 $token = $tokens->[++$i];
78              
79 20 100       29 if ($token->{type} == RIGHT_PAREN) { # no args
80             push @violations, {
81             filename => $file,
82             line => $token->{line},
83 3         8 description => DESC,
84             explanation => EXPL,
85             policy => __PACKAGE__,
86             };
87 3         5 next;
88             }
89              
90 17         11 my $left_paren_num = 1;
91 17         28 for (; my $token = $tokens->[$i]; $i++) {
92 56         27 my $token_type = $token->{type};
93              
94 56 100       124 if ($token_type == LEFT_PAREN) {
    100          
    50          
95 3         6 $left_paren_num++;
96             }
97             elsif ($token_type == RIGHT_PAREN) {
98 20 100       34 last if --$left_paren_num <= 0;
99             }
100             elsif ($token_type == COMMA) {
101             push @violations, {
102             filename => $file,
103             line => $token->{line},
104 0         0 description => DESC,
105             explanation => EXPL,
106             policy => __PACKAGE__,
107             };
108 0         0 last;
109             }
110             }
111 17         27 next;
112             }
113              
114 16         13 my $is_op_in_arg = 0;
115 16         8 my $left_paren_num = 1;
116 16         28 for ($i++; my $token = $tokens->[$i]; $i++) {
117 113         77 my $token_type = $token->{type};
118              
119 113 100 66     343 if ($token_type == LEFT_PAREN) {
    100          
    100          
120 7         11 $left_paren_num++;
121             }
122             elsif ($token_type == RIGHT_PAREN) {
123 23 100       45 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       21 if ($is_op_in_arg) {
131 1         2 next;
132             }
133              
134 15         11 $token = $tokens->[++$i];
135 15         14 my $token_data = $token->{data};
136 15 100 100     79 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         9 next;
146             }
147              
148             push @violations, {
149             filename => $file,
150             line => $token->{line},
151 10         41 description => DESC,
152             explanation => EXPL,
153             policy => __PACKAGE__,
154             };
155             }
156             }
157             }
158              
159 15         50 return \@violations;
160             }
161              
162             1;