7 use Thread::Pool::Simple;
9 if (eval { require PPI; 1 }) {
10 plan tests => scalar(@Support::Files::testitems);
12 plan skip_all => "PPI not installed";
15 my @testitems = @Support::Files::testitems;
23 # due to a bug in PPI it cannot determine the encoding of a source file by
24 # use utf8; normaly this would be no problem but some people instist on
25 # putting strange stuff into the source. as a workaround read in the source
26 # with :utf8 layer and pass it to PPI by reference
27 # there are still some latin chars, but it's not the purpose of this test
28 # to find them, so warnings about it will be ignored
29 local $^W = 0; # don't care about invalid chars in comments
31 open my $fh, '<:utf8', $file or die $!;
35 my $doc = PPI::Document->new(\$source) or do {
36 print "?: PPI error for file $file: " . PPI::Document::errstr() . "\n";
40 my $stmts = $doc->find(sub { $_[1]->isa('PPI::Token::Word') && $_[1]->content eq 'new' });
42 for my $stmt (@{ $stmts || [] }) {
43 my @schildren = $stmt->parent->schildren;
44 for (0..$#schildren-1) {
45 my $this = $schildren[$_];
46 my $next = $schildren[$_+1];
48 next unless $this->isa('PPI::Token::Word');
49 next unless $this->content eq 'new';
50 next unless $next->isa('PPI::Token::Word');
52 # suspicious. 2 barewords in a row, with the first being 'new'
53 # but maybe its somethiing like: Obj->new param1 => ...
54 # check if the one before exists and is a ->
55 next if $_ == 0 || ($schildren[$_-1]->isa('PPI::Token::Operator') && $schildren[$_-1]->content eq '->');
58 print "?: @{[ $this->content, $next->content ]} \n";
65 my $pool = Thread::Pool::Simple->new(
67 max => Sys::CPU::cpu_count() + 1,
68 do => [ \&test_file ],
72 $pool->add($_) for @testitems;