File Coverage

blib/lib/Perl/Lint/Policy/ControlStructures/ProhibitUntilBlocks.pm
Criterion Covered Total %
statement 29 30 96.6
branch 9 12 75.0
condition n/a
subroutine 6 6 100.0
pod 0 1 0.0
total 44 49 89.8


line stmt bran cond sub pod time code
1             package Perl::Lint::Policy::ControlStructures::ProhibitUntilBlocks;
2 134     134   68594 use strict;
  134         167  
  134         3193  
3 134     134   387 use warnings;
  134         144  
  134         2429  
4 134     134   779 use Perl::Lint::Constants::Type;
  134         158  
  134         60437  
5 134     134   571 use parent "Perl::Lint::Policy";
  134         146  
  134         574  
6              
7             use constant {
8 134         26851 DESC => '"until" block used',
9             EXPL => [97],
10 134     134   6739 };
  134         172  
11              
12             sub evaluate {
13 5     5 0 11 my ($class, $file, $tokens, $src, $args) = @_;
14              
15 5         7 my @violations;
16 5         19 for (my $i = 0; my $token = $tokens->[$i]; $i++) {
17 102         73 my $token_type = $token->{type};
18              
19 102 100       171 if ($token_type == UNTIL_STATEMENT) {
20 7 100       15 if ($tokens->[++$i]->{type} == LEFT_PAREN) {
21 6         6 my $left_paren_num = 1;
22 6         11 for ($i++; my $token = $tokens->[$i]; $i++) {
23 12         9 my $token_type = $token->{type};
24 12 50       28 if ($token_type == LEFT_PAREN) {
    100          
25 0         0 $left_paren_num++;
26             }
27             elsif ($token_type == RIGHT_PAREN) {
28 6 50       12 last if --$left_paren_num <= 0;
29             }
30             }
31 6 50       9 if ($tokens->[++$i]->{type} == LEFT_BRACE) {
32             push @violations, {
33             filename => $file,
34             line => $token->{line},
35 6         25 description => DESC,
36             explanation => EXPL,
37             policy => __PACKAGE__,
38             };
39             }
40             }
41             }
42             }
43              
44 5         15 return \@violations;
45             }
46              
47             1;
48