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