1use strict;
2use warnings;
3use Perl::Lint::Policy::ValuesAndExpressions::ProhibitLongChainsOfMethodCalls;
4use t::Policy::Util qw/fetch_violations/;
5use Test::Base::Less;
6
7my $class_name = 'ValuesAndExpressions::ProhibitLongChainsOfMethodCalls';
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;
28$x->y();
29$x->y(@foo);
30$x->y(\%foo, *bar);
31
32$x->y->z;
33$x->y()->z();
34$x->y(@foo)->z(@bar);
35$x->y(\%foo, *bar)->z($baz, $qux);
36
37$x->y->z->w;
38$x->y()->z()->w();
39$x->y(@foo)->z(@bar)->w(%baz);
40$x->y(\%foo, *bar)->z($baz, $qux)->w(\@xyzzy, $plugh);
41
42===
43--- dscr: Basic failure
44--- failures: 4
45--- params:
46--- input
47$x->y->z->w->u;
48$x->y()->z()->w()->u();
49$x->y(@foo)->z(@bar)->w(%baz)->u($qux);
50$x->y(\%foo, *bar)->z($baz, $qux)->w(\@xyzzy, $plugh)->u(@joe, @blow);
51
52===
53--- dscr: Reduced maximum chain length
54--- failures: 4
55--- params: {prohibit_long_chains_of_method_calls => {max_chain_length => 2}}
56--- input
57$x->y->z->w;
58$x->y()->z()->w();
59$x->y(@foo)->z(@bar)->w(%baz);
60$x->y(\%foo, *bar)->z($baz, $qux)->w(\@xyzzy, $plugh);
61
62===
63--- dscr: Increased maximum chain length
64--- failures: 0
65--- params: {prohibit_long_chains_of_method_calls => {max_chain_length => 4}}
66--- input
67$x->y->z->w->u;
68$x->y()->z()->w()->u();
69$x->y(@foo)->z(@bar)->w(%baz)->u($qux);
70$x->y(\%foo, *bar)->z($baz, $qux)->w(\@xyzzy, $plugh)->u(@joe, @blow);
71
72===
73--- dscr: Ignore array and hash ref chains
74--- failures: 0
75--- params:
76--- input
77$blargh = $x->{y}->{z}->{w}->{u};
78$blargh = $x->[1]->[2]->[3]->[4];
79$blargh = $x->{y}->[2]->{w}->[4];
80$blargh = $x->[1]->{z}->[3]->{u};
81
82===
83--- dscr: RT #30040
84--- failures: 0
85--- params:
86--- input
87$c->response->content_type( 'text/html; charset=utf-8' )
88    unless $c->response->content_type;
89
90===
91--- dscr: no lint
92--- failures: 3
93--- params:
94--- input
95$x->y->z->w->u;
96$x->y()->z()->w()->u();
97$x->y(@foo)->z(@bar)->w(%baz)->u($qux); ## no lint
98$x->y(\%foo, *bar)->z($baz, $qux)->w(\@xyzzy, $plugh)->u(@joe, @blow);
99