1package Perl::Lint::Policy::TestingAndDebugging::RequireTestLabels;
2use strict;
3use warnings;
4use List::Util qw/any/;
5use Perl::Lint::Constants::Type;
6use parent "Perl::Lint::Policy";
7
8use constant {
9    DESC => 'Test without a label',
10    EXPL => 'Add a label argument to all Test::More functions',
11};
12
13sub evaluate {
14    my ($class, $file, $tokens, $src, $args) = @_;
15
16    my @target_test_module = ('Test::More');
17
18    if (my $this_policies_arg = $args->{require_test_labels}) {
19        push @target_test_module, split / /, ($this_policies_arg->{modules} || '');
20    }
21
22    my @violations;
23    my $is_loaded = 0;
24    my $token_num = scalar @$tokens;
25    for (my $i = 0; $i < $token_num; $i++) {
26        my $token = $tokens->[$i];
27        my $token_type = $token->{type};
28        my $token_data = $token->{data};
29
30        # for checking Test::More is loaded
31        if ($token_type == USE_DECL || $token_type == REQUIRE_DECL) {
32            next if $is_loaded;
33
34            my $used_module_name = '';
35            for ($i++; $i < $token_num; $i++) {
36                my $token = $tokens->[$i];
37                my $token_type = $token->{type};
38                if ($token_type == NAMESPACE || $token_type == NAMESPACE_RESOLVER) {
39                    $used_module_name .= $token->{data};
40                }
41                else {
42                    last;
43                }
44            }
45
46            if (any {$_ eq $used_module_name} @target_test_module) {
47                $is_loaded = 1;
48            }
49            next;
50        }
51
52        if ($token_type == KEY) {
53            if ($token_data eq 'pass' || $token_data eq 'fail') {
54                if (
55                    $tokens->[$i+1]->{type} == SEMI_COLON ||
56                    (
57                        $tokens->[$i+1]->{type} == LEFT_PAREN &&
58                        $tokens->[$i+2]->{type} == RIGHT_PAREN
59                    )
60                ) {
61                    push @violations, {
62                        filename => $file,
63                        line     => $token->{line},
64                        description => DESC,
65                        explanation => EXPL,
66                        policy => __PACKAGE__,
67                    };
68                }
69                next;
70            }
71
72            my $expected_commma_num = 0;
73            if ($token_data eq 'ok') {
74                $expected_commma_num = 1;
75            }
76            elsif ($token_data eq 'cmp_ok') {
77                $expected_commma_num = 3;
78            }
79            elsif (
80                $token_data eq 'is'     ||
81                $token_data eq 'isnt'   ||
82                $token_data eq 'like'   ||
83                $token_data eq 'unlike' ||
84                $token_data eq 'is_deeply'
85            ) {
86                $expected_commma_num = 2;
87            }
88
89            if ($expected_commma_num) {
90                my $left_paren_num   = 0;
91                my $left_brace_num   = 0;
92                my $left_bracket_num = 0;
93                my $comma_num = 0;
94
95                $i++ if $tokens->[$i+1]->{type} == LEFT_PAREN;
96
97                for ($i++; $i < $token_num; $i++) {
98                    my $token = $tokens->[$i];
99                    my $token_type = $token->{type};
100                    my $token_data = $token->{data};
101
102                    if ($token_type == LEFT_PAREN) {
103                        $left_paren_num++;
104                    }
105                    elsif ($token_type == LEFT_BRACE) {
106                        $left_brace_num++;
107                    }
108                    elsif ($token_type == LEFT_BRACKET) {
109                        $left_bracket_num++;
110                    }
111                    elsif ($token_type == RIGHT_PAREN) {
112                        $left_paren_num--;
113                    }
114                    elsif ($token_type == RIGHT_BRACE) {
115                        $left_brace_num--;
116                    }
117                    elsif ($token_type == RIGHT_BRACKET) {
118                        $left_bracket_num--;
119                    }
120                    elsif (
121                        $token_type == COMMA &&
122                        $left_paren_num <= 0  &&
123                        $left_brace_num <= 0  &&
124                        $left_bracket_num <= 0
125                    ) {
126                        $comma_num++;
127                    }
128                    elsif (
129                        $token_type == SEMI_COLON &&
130                        $left_paren_num <= 0       &&
131                        $left_brace_num <= 0       &&
132                        $left_bracket_num <= 0
133                    ) {
134                        if ($comma_num < $expected_commma_num) {
135                            push @violations, {
136                                filename => $file,
137                                line     => $token->{line},
138                                description => DESC,
139                                explanation => EXPL,
140                                policy => __PACKAGE__,
141                            };
142                        }
143                        last;
144                    }
145                }
146            }
147        }
148    }
149
150    return \@violations if $is_loaded;
151    return [];
152}
153
1541;
155
156