t/structure/no_lexicals_in_postif.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 $fh;
  16 {
  17     local $^W = 0;  # Don't complain about non-existent filehandles
  18     if (-e \*Test::More::TESTOUT) {
  19         $fh = \*Test::More::TESTOUT;
  20     } elsif (-e \*Test::Builder::TESTOUT) {
  21         $fh = \*Test::Builder::TESTOUT;
  22     } else {
  23         $fh = \*STDOUT;
  24     }
  25 }
  26
  27 my @testitems = @Support::Files::testitems;
  28
  29 sub test_file {
  30   my ($file) = @_;
  31   my $clean = 1;
  32   my $source;
  33   {
  34     # due to a bug in PPI it cannot determine the encoding of a source file by
  35     # use utf8; normaly this would be no problem but some people instist on
  36     # putting strange stuff into the source. as a workaround read in the source
  37     # with :utf8 layer and pass it to PPI by reference
  38     # there are still some latin chars, but it's not the purpose of this test
  39     # to find them, so warnings about it will be ignored
  40     local $^W = 0; # don't care about invalid chars in comments
  41     local $/ = undef;
  42     open my $fh, '<:utf8', $file or die $!;
  43     $source = <$fh>;
  44   }
  45
  46   my $doc = PPI::Document->new(\$source) or do {
  47     print $fh "?: PPI error for file $file: " . PPI::Document::errstr() . "\n";
  48     ok 0, $file;
  49     next;
  50   };
  51   my $stmts = $doc->find('Statement::Variable');
  52
  53   for my $var (@{ $stmts || [] }) {
  54     # local can have valid uses like this, and our is extremely uncommon
  55     next unless $var->type eq 'my';
  56
  57     # no if? alright
  58     next unless $var->find(sub { $_[1]->content eq 'if' });
  59
  60     # token "if" is not in the top level struvture - no problem
  61     # most likely an anonymous sub or a complicated map/grep/reduce
  62     next unless grep { $_->content eq 'if'  } $var->schildren;
  63
  64     $clean = 0;
  65     print $fh "?: $var \n";
  66   }
  67
  68   ok $clean, $file;
  69 }
  70
  71 my $pool = Thread::Pool::Simple->new(
  72   min    => 2,
  73   max    => Sys::CPU::cpu_count() + 1,
  74   do     => [ \&test_file ],
  75   passid => 0,
  76 );
  77
  78 $pool->add($_) for @testitems;
  79
  80 $pool->join;