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