6 my ($tests, $subtests);
12 use Test::More tests => $tests + $subtests * 21;
14 use Perl::Critic::TestUtils qw/pcritique_with_violations/;
16 Perl::Critic::TestUtils::block_perlcriticrc();
18 my $policy = 'Dynamic::NoIndirect';
28 my ($code, $expected) = split /^-+$/m, $_, 2;
29 my @expected = eval $expected;
31 my @violations = eval { pcritique_with_violations($policy, \$code) };
34 diag "Compilation $id failed: $@";
38 is @violations, @expected, "right count of violations $id";
40 for my $v (@violations) {
41 my $exp = shift @expected;
44 fail "Unexpected violation for chunk $id: " . $v->description;
48 my $pos = $v->location;
49 my ($meth, $obj, $line, $col) = @$exp;
52 qr/^Indirect call of method \"\Q$meth\E\" on object \"\Q$obj\E\"/,
54 is $pos->[0], $line, "line $id";
55 is $pos->[1], $col, "column $id";
67 my $x = new X; $x = new X;
69 [ 'new', 'X', 1, 9 ], [ 'new', 'X', 1, 21 ]
73 [ 'new', 'X', 1, 9 ], [ 'new', 'X', 1, 18 ]
78 [ 'new', 'X', 1, 9 ], [ 'new', 'X', 2, 9 ]
89 [ 'new', 'X', 1, 9 ], [ 'new', 'X', 2, 4 ]
93 [ 'new', 'new', 1, 9 ]
98 [ 'new', '$obj', 2, 9 ]
101 my $x = new $obj; $x = new $obj;
103 [ 'new', '$obj', 2, 9 ], [ 'new', '$obj', 2, 24 ]
106 my $x = new $obj new $obj;
108 [ 'new', '$obj', 2, 9 ], [ 'new', '$obj', 2, 21 ]
114 [ 'new', '$obj', 2, 9 ], [ 'new', '$obj', 3, 9 ]
120 [ 'new', '$obj', 2, 9 ]
127 [ 'new', '$obj', 2, 9 ], [ 'new', '$obj', 3, 7 ]