1use strict; 2use warnings; 3use Perl::Lint::Policy::ValuesAndExpressions::ProhibitCommaSeparatedStatements; 4use t::Policy::Util qw/fetch_violations/; 5use Test::Base::Less; 6 7my $class_name = 'ValuesAndExpressions::ProhibitCommaSeparatedStatements'; 8 9filters { 10 params => [qw/eval/], # TODO wrong! 11}; 12 13for my $block (blocks) { 14 my $violations = fetch_violations($class_name, $block->input, $block->params); 15 is scalar @$violations, $block->failures, $block->dscr; 16} 17 18done_testing; 19 20__DATA__ 21 22=== 23--- dscr: Basic passing 24--- failures: 0 25--- params: 26--- input 27@x = (@y, @z); 28my $expl = [133, 138]; 29$lookup = { a => 1, b => 2 }; 30 31=== 32--- dscr: Basic failure 33--- failures: 1 34--- params: 35--- input 36@x = @y, @z; 37 38=== 39--- dscr: List including assignments 40--- failures: 0 41--- params: 42--- input 43@w = ($x = 1, $y = 2, $z = 3); 44 45=== 46--- dscr: List containing statement 47--- failures: 0 48--- params: 49--- input 50@w = ( {}, [] ); 51 52=== 53--- dscr: List containing statement in a constructor that is reported as a block 54--- failures: 0 55--- params: 56--- input 57my %foo = ( 58 blah => { 59 blah => 'blah', 60 }, 61); 62 63=== 64--- dscr: Regular statement inside a block. 65--- failures: 0 66--- params: 67--- input 68foreach my $path ( @ARGV ) { 69 utter 'Looking at ', $path, '.'; 70} 71 72=== 73--- dscr: Sub call after comma 74--- failures: 1 75--- params: 76--- input 77@x = @y, foo @z; 78 79=== 80--- dscr: Regular sub call before comma 81--- failures: 1 82--- params: 83--- input 84# The space between the sub name and the left parenthesis is significant 85# in that part of Conway's point is that things that look like lists may 86# not be. 87 88@x = foo (@y), @z; 89 90=== 91--- dscr: No-argument sub call via use of sigil 92--- failures: 1 93--- params: 94--- input 95@x = &foo, @y, bar @z; 96 97=== 98--- dscr: Two sub calls 99--- failures: 0 100--- params: 101--- input 102@x = foo @y, bar @z; 103 104=== 105--- dscr: Built-in call that provides a list context without parentheses 106--- failures: 0 107--- params: 108--- input 109@x = push @y, @z; 110 111=== 112--- dscr: Built-in call that provides a list context, called like a function 113--- failures: 1 114--- params: 115--- input 116@x = push (@y), @z; 117 118=== 119--- dscr: Built-in call that takes multiple arguments without parentheses 120--- failures: 0 121--- params: 122--- input 123@x = substr $y, 1, 2; 124 125=== 126--- dscr: Built-in call that takes multiple arguments, called like a function 127--- failures: 1 128--- params: 129--- input 130@x = substr ($y, 1), 2; 131 132=== 133--- dscr: Call to unary built-in without parentheses 134--- failures: 1 135--- params: 136--- input 137@x = tied @y, @z; 138 139=== 140--- dscr: Unary built-in, called like a function 141--- failures: 1 142--- params: 143--- input 144@x = tied (@y), @z; 145 146=== 147--- dscr: Call to no-argument built-in without parentheses 148--- failures: 1 149--- params: 150--- input 151@x = time, @z; 152 153=== 154--- dscr: No-argument built-in, called like a function 155--- failures: 1 156--- params: 157--- input 158@x = time (), @z; 159 160=== 161--- dscr: Call to optional argument built-in without an argument without parentheses 162--- failures: 1 163--- params: 164--- input 165@x = sin, @z; 166 167=== 168--- dscr: Optional argument built-in, called like a function without an argument 169--- failures: 1 170--- params: 171--- input 172@x = sin (), @z; 173 174=== 175--- dscr: Call to optional argument built-in with an argument without parentheses 176--- failures: 1 177--- params: 178--- input 179@x = sin @y, @z; 180 181=== 182--- dscr: Optional argument built-in, called like a function with an argument 183--- failures: 1 184--- params: 185--- input 186@x = sin (@y), @z; 187 188=== 189--- dscr: For loop 190--- failures: 2 191--- params: 192--- input 193for ($x = 0, $y = 0; $x < 10; $x++, $y += 2) { 194 foo($x, $y); 195} 196 197=== 198--- dscr: For loop 199--- failures: 0 200--- params: 201--- input 202for ($x, 'x', @y, 1, ) { 203 print; 204} 205 206=== 207--- dscr: qw<> 208--- failures: 0 209--- params: 210--- input 211@list = qw<1, 2, 3>; # this really means @list = ('1,', '2,', '3'); 212 213=== 214--- dscr: original RT #27654 215--- failures: 0 216--- params: 217--- input 218my @arr1; 219@arr1 = split /b/, 'abc'; 220 221=== 222--- dscr: RT #27654 - NKH example 1 223--- failures: 0 224--- params: 225--- input 226return 227 { 228 "string" => $aliased_history, 229 TIME => $self->{something}, 230 } ; 231 232=== 233--- dscr: RT #27654 - NKH example 2 - without allow_last_statement_to_be_comma_separated_in_map_and_grep 234--- failures: 2 235--- params: 236--- input 237%hash = map {$_, 1} @list ; 238%hash = grep {$_, 1} @list ; 239 240=== 241--- dscr: RT #27654 - NKH example 2 - with allow_last_statement_to_be_comma_separated_in_map_and_grep 242--- failures: 0 243--- params: {prohibit_comma_separated_statements => {allow_last_statement_to_be_comma_separated_in_map_and_grep => 1}} 244--- input 245%hash = map {$_, 1} @list ; 246%hash = grep {$_, 1} @list ; 247 248=== 249--- dscr: RT #27654 - NKH example 3 250--- failures: 0 251--- params: 252--- input 253## TODO PPI parses this code as blocks and not hash constructors. 254$self->DoSomething 255 ( 256 { %{$a_hash_ref}, %{$another_hash_ref}}, 257 @more_data, 258 ) ; 259 260=== 261--- dscr: RT #33935 and 49679 262--- failures: 0 263--- params: 264--- input 265func( @{ $href }{'1', '2'} ); 266 267=== 268--- dscr: RT #61301 (requires PPI 1.215) 269--- failures: 0 270--- params: 271--- input 272sub foo { 273 return { bar => 1, answer => 42 }; 274} 275 276=== 277--- dscr: RT #64132 (requires PPI 1.215) 278--- failures: 0 279--- params: 280--- input 281sub new { 282 return bless { foo => 1, bar => 2 }, __PACKAGE__; 283} 284 285=== 286--- dscr: no lint 287--- failures: 0 288--- params: 289--- input 290@x = @y, @z; ## no lint 291 292