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