File Coverage

blib/lib/Perl/Lint/Policy/RegularExpressions/RequireLineBoundaryMatching.pm
Criterion Covered Total %
statement 73 73 100.0
branch 28 30 93.3
condition 42 55 76.3
subroutine 6 6 100.0
pod 0 1 0.0
total 149 165 90.3


line stmt bran cond sub pod time code
1             package Perl::Lint::Policy::RegularExpressions::RequireLineBoundaryMatching;
2 134     134   70939 use strict;
  134         176  
  134         3383  
3 134     134   423 use warnings;
  134         153  
  134         2545  
4 134     134   784 use Perl::Lint::Constants::Type;
  134         149  
  134         61131  
5 134     134   581 use parent "Perl::Lint::Policy";
  134         152  
  134         596  
6              
7             use constant {
8 134         59141 DESC => 'Regular expression without "/m" flag',
9             EXPL => [237],
10 134     134   6841 };
  134         169  
11              
12             sub evaluate {
13 11     11 0 18 my ($class, $file, $tokens, $src, $args) = @_;
14              
15 11         9 my @violations;
16              
17 11         9 my $depth = 0;
18 11         10 my $is_non_target_reg = 0;
19              
20 11         7 my $enabled_re_m_depth = -1; # use negative value as default
21 11         9 my @enabled_re_m_depths;
22              
23 11         7 my $disable_re_m_depth = -1; # use negative value as default
24 11         10 my @disable_re_m_depths;
25              
26 11         29 for (my $i = 0; my $token = $tokens->[$i]; $i++) {
27 592         380 my $token_type = $token->{type};
28 592         372 my $token_data = $token->{data};
29              
30 592         422 my $next_token = $tokens->[$i+1];
31 592         361 my $next_token_type = $next_token->{type};
32 592         414 my $next_token_data = $next_token->{data};
33              
34 592 100 100     1338 if (!$is_non_target_reg && $token_type == REG_DELIM) {
35 98 100 66     276 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 !~ /m/) # when the `m` regex option doesn't exist
40             )
41             ) {
42 32 100 66     127 if (
      100        
      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             push @violations, {
47             filename => $file,
48             line => $token->{line},
49 25         69 description => DESC,
50             explanation => EXPL,
51             policy => __PACKAGE__,
52             };
53             }
54             }
55              
56 98         145 next;
57             }
58              
59             # Ignore regexes which are unnecessary to check
60             # XXX more?
61 494 50 100     2274 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         6 $is_non_target_reg = 1;
68 10         18 next;
69             }
70              
71 484 100       519 if ($token_type == SEMI_COLON) {
72 68         47 $is_non_target_reg = 0;
73 68         101 next;
74             }
75              
76             # Represent block scope hierarchy
77 416 100       443 if ($token_type == LEFT_BRACE) {
78 7         7 $depth++;
79 7         10 next;
80             }
81 409 100       407 if ($token_type == RIGHT_BRACE) {
82 7 100       12 if ($enabled_re_m_depth == $depth) {
83 2         2 pop @enabled_re_m_depths;
84 2   100     7 $enabled_re_m_depth = $enabled_re_m_depths[-1] // -1;
85             }
86 7 100       12 if ($disable_re_m_depth == $depth) {
87 1         2 pop @disable_re_m_depths;
88 1   50     4 $disable_re_m_depth = $disable_re_m_depths[-1] // -1;
89             }
90 7         7 $depth--;
91 7         11 next;
92             }
93              
94             # for
95             # `use re qw{/m}`
96             # `use re '/m'`
97 402 100 100     515 if ($token_type == USED_NAME && $token_data eq 're') {
98 6         16 for ($i++; $token = $tokens->[$i]; $i++) {
99 24         16 $token_type = $token->{type};
100 24         19 $token_data = $token->{data};
101 24 100       30 if ($token_type == SEMI_COLON) {
102 6         7 last;
103             }
104 18 100 100     96 if (
      66        
105             ($token_type == RAW_STRING || $token_type == STRING || $token_type == REG_EXP) &&
106             $token_data =~ /m/
107             ) {
108 6         8 push @enabled_re_m_depths, $depth;
109 6         12 $enabled_re_m_depth = $depth;
110             }
111             }
112              
113 6         10 next;
114             }
115              
116             # for
117             # `no re qw{/m}`
118             # `no re '/m'`
119 396 50 100     824 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         3 for ($i++; $token = $tokens->[$i]; $i++) {
126 6         5 $token_type = $token->{type};
127 6         5 $token_data = $token->{data};
128 6 100       9 if ($token_type == SEMI_COLON) {
129 1         1 last;
130             }
131 5 100 66     32 if (
      66        
132             ($token_type == RAW_STRING || $token_type == STRING || $token_type == REG_EXP) &&
133             $token_data =~ /m/
134             ) {
135 1         2 push @disable_re_m_depths, $depth;
136 1         2 $disable_re_m_depth = $depth;
137             }
138             }
139              
140 1         3 next;
141             }
142             }
143              
144 11         41 return \@violations;
145             }
146              
147             1;
148