6 if (eval { require PPI; 1 }) {
7 plan tests => scalar(@Support::Files::testitems);
9 plan skip_all => "PPI not installed";
12 my @testitems = @Support::Files::testitems;
14 foreach my $file (@testitems) {
18 # due to a bug in PPI it cannot determine the encoding of a source file by
19 # use utf8; normaly this would be no problem but some people instist on
20 # putting strange stuff into the source. as a workaround read in the source
21 # with :utf8 layer and pass it to PPI by reference
22 # there are still some latin chars, but it's not the purpose of this test
23 # to find them, so warnings about it will be ignored
24 local $^W = 0; # don't care about invalid chars in comments
26 open my $fh, '<:utf8', $file or die $!;
30 my $doc = PPI::Document->new(\$source) or do {
31 print "?: PPI error for file $file: " . PPI::Document::errstr() . "\n";
35 my $stmts = $doc->find(sub { $_[1]->isa('PPI::Token::Word') && $_[1]->content eq 'new' });
37 for my $stmt (@{ $stmts || [] }) {
38 my @schildren = $stmt->parent->schildren;
39 for (0..$#schildren-1) {
40 my $this = $schildren[$_];
41 my $next = $schildren[$_+1];
43 next unless $this->isa('PPI::Token::Word');
44 next unless $this->content eq 'new';
45 next unless $next->isa('PPI::Token::Word');
47 # suspicious. 2 barewords in a row, with the first being 'new'
48 # but maybe its somethiing like: Obj->new param1 => ...
49 # check if the one before exists and is a ->
50 next if $_ == 0 || ($schildren[$_-1]->isa('PPI::Token::Operator') && $schildren[$_-1]->content eq '->');
53 print "?: @{[ $this->content, $next->content ]} \n";