t/structure/no_indirect_object_notation.t

   1 use strict;
   2 use threads;
   3 use lib 't';
   4 use Support::Files;
   5 use Sys::CPU;
   6 use Test::More;
   7 use Thread::Pool::Simple;
   8
   9 if (eval { require PPI; 1 }) {
  10   plan tests => scalar(@Support::Files::testitems);
  11 } else {
  12   plan skip_all => "PPI not installed";
  13 }
  14
  15 my @testitems = @Support::Files::testitems;
  16
  17 sub test_file {
  18   my ($file) = @_;
  19
  20   my $clean = 1;
  21   my $source;
  22   {
  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
  30     local $/ = undef;
  31     open my $fh, '<:utf8', $file or die $!;
  32     $source = <$fh>;
  33   }
  34
  35   my $doc = PPI::Document->new(\$source) or do {
  36     print "?: PPI error for file $file: " . PPI::Document::errstr() . "\n";
  37     ok 0, $file;
  38     next;
  39   };
  40   my $stmts = $doc->find(sub { $_[1]->isa('PPI::Token::Word') && $_[1]->content eq 'new' });
  41
  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];
  47
  48       next unless $this->isa('PPI::Token::Word');
  49       next unless $this->content eq 'new';
  50       next unless $next->isa('PPI::Token::Word');
  51
  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 '->');
  56
  57       $clean = 0;
  58       print "?: @{[ $this->content, $next->content ]} \n";
  59     }
  60   }
  61
  62   ok $clean, $file;
  63 }
  64
  65 my $pool = Thread::Pool::Simple->new(
  66   min    => 2,
  67   max    => Sys::CPU::cpu_count() + 1,
  68   do     => [ \&test_file ],
  69   passid => 0,
  70 );
  71
  72 $pool->add($_) for @testitems;
  73
  74 $pool->join;