File Coverage

blib/lib/Perl/Lint/Policy/RegularExpressions/RequireDotMatchAnything.pm
Criterion Covered Total %
statement 73 73 100.0
branch 28 30 93.3
condition 40 55 72.7
subroutine 6 6 100.0
pod 0 1 0.0
total 147 165 89.0


line stmt bran cond sub pod time code
1             package Perl::Lint::Policy::RegularExpressions::RequireDotMatchAnything;
2 134     134   97880 use strict;
  134         249  
  134         4961  
3 134     134   726 use warnings;
  134         224  
  134         3505  
4 134     134   985 use Perl::Lint::Constants::Type;
  134         186  
  134         83524  
5 134     134   767 use parent "Perl::Lint::Policy";
  134         236  
  134         850  
6              
7             use constant {
8 134         75371 DESC => 'Regular expression without "/s" flag',
9             EXPL => [240, 241],
10 134     134   9730 };
  134         241  
11              
12             sub evaluate {
13 10     10 0 20 my ($class, $file, $tokens, $src, $args) = @_;
14              
15 10         14 my @violations;
16              
17 10         13 my $depth = 0;
18 10         9 my $is_non_target_reg = 0;
19              
20 10         16 my $enabled_re_m_depth = -1; # use negative value as default
21 10         9 my @enabled_re_m_depths;
22              
23 10         11 my $disable_re_m_depth = -1; # use negative value as default
24 10         10 my @disable_re_m_depths;
25              
26 10         42 for (my $i = 0; my $token = $tokens->[$i]; $i++) {
27 532         424 my $token_type = $token->{type};
28 532         419 my $token_data = $token->{data};
29              
30 532         426 my $next_token = $tokens->[$i+1];
31 532         416 my $next_token_type = $next_token->{type};
32 532         434 my $next_token_data = $next_token->{data};
33              
34 532 100 100     1395 if (!$is_non_target_reg && $token_type == REG_DELIM) {
35 86 100 66     304 if (
      33        
36             defined $next_token_type &&
37             (
38             $next_token_type == SEMI_COLON || # when any regex options don't exist
39             ($next_token_type == REG_OPT && $next_token_data !~ /s/) # when the `m` regex option doesn't exist
40             )
41             ) {
42 26 100 66     82 if (
      66        
      66        
43             !($enabled_re_m_depth >= 0 && $depth >= $enabled_re_m_depth) ||
44             ($disable_re_m_depth >= 0 && $disable_re_m_depth > $enabled_re_m_depth)
45             ) {
46 24         167 push @violations, {
47             filename => $file,
48             line => $token->{line},
49             description => DESC,
50             explanation => EXPL,
51             policy => __PACKAGE__,
52             };
53             }
54             }
55              
56 86         289 next;
57             }
58              
59             # Ignore regexes which are unnecessary to check
60             # XXX more?
61 446 50 100     2287 if (
      66        
      66        
62             $token_type == REG_ALL_REPLACE ||
63             $token_type == REG_LIST ||
64             $token_type == REG_QUOTE ||
65             $token_type == REG_EXEC
66             ) {
67 10         9 $is_non_target_reg = 1;
68 10         18 next;
69             }
70              
71 436 100       542 if ($token_type == SEMI_COLON) {
72 62         43 $is_non_target_reg = 0;
73 62         117 next;
74             }
75              
76             # Represent block scope hierarchy
77 374 100       426 if ($token_type == LEFT_BRACE) {
78 3         5 $depth++;
79 3         8 next;
80             }
81 371 100       449 if ($token_type == RIGHT_BRACE) {
82 3 100       9 if ($enabled_re_m_depth == $depth) {
83 1         2 pop @enabled_re_m_depths;
84 1   50     6 $enabled_re_m_depth = $enabled_re_m_depths[-1] // -1;
85             }
86 3 100       9 if ($disable_re_m_depth == $depth) {
87 1         1 pop @disable_re_m_depths;
88 1   50     6 $disable_re_m_depth = $disable_re_m_depths[-1] // -1;
89             }
90 3         3 $depth--;
91 3         9 next;
92             }
93              
94             # for
95             # `use re qw{/s}`
96             # `use re '/s'`
97 368 100 100     555 if ($token_type == USED_NAME && $token_data eq 're') {
98 4         14 for ($i++; $token = $tokens->[$i]; $i++) {
99 17         16 $token_type = $token->{type};
100 17         19 $token_data = $token->{data};
101 17 100       27 if ($token_type == SEMI_COLON) {
102 4         7 last;
103             }
104 13 100 100     92 if (
      66        
105             ($token_type == RAW_STRING || $token_type == STRING || $token_type == REG_EXP) &&
106             $token_data =~ /s/
107             ) {
108 4         6 push @enabled_re_m_depths, $depth;
109 4         9 $enabled_re_m_depth = $depth;
110             }
111             }
112              
113 4         13 next;
114             }
115              
116             # for
117             # `no re qw{/s}`
118             # `no re '/s'`
119 364 50 100     908 if (
      66        
      66        
120             $token_type == BUILTIN_FUNC &&
121             $token_data eq 'no' &&
122             $next_token_type == KEY &&
123             $next_token_data eq 're'
124             ) {
125 1         5 for ($i++; $token = $tokens->[$i]; $i++) {
126 6         7 $token_type = $token->{type};
127 6         7 $token_data = $token->{data};
128 6 100       9 if ($token_type == SEMI_COLON) {
129 1         2 last;
130             }
131 5 100 66     37 if (
      66        
132             ($token_type == RAW_STRING || $token_type == STRING || $token_type == REG_EXP) &&
133             $token_data =~ /s/
134             ) {
135 1         3 push @disable_re_m_depths, $depth;
136 1         3 $disable_re_m_depth = $depth;
137             }
138             }
139              
140 1         4 next;
141             }
142             }
143              
144 10         56 return \@violations;
145             }
146              
147             1;
148