t/structure/no_lexicals_in_postif.t

   1 use strict;
   2 use lib 't';
   3 use Support::Files;
   4 use Test::More;
   5
   6 if (eval { require PPI; 1 }) {
   7   plan tests => scalar(@Support::Files::testitems);
   8 } else {
   9   plan skip_all => "PPI not installed";
  10 }
  11
  12 my $fh;
  13 {
  14     local $^W = 0;  # Don't complain about non-existent filehandles
  15     if (-e \*Test::More::TESTOUT) {
  16         $fh = \*Test::More::TESTOUT;
  17     } elsif (-e \*Test::Builder::TESTOUT) {
  18         $fh = \*Test::Builder::TESTOUT;
  19     } else {
  20         $fh = \*STDOUT;
  21     }
  22 }
  23
  24 my @testitems = @Support::Files::testitems;
  25
  26 foreach my $file (@testitems) {
  27   my $clean = 1;
  28   my $source;
  29   {
  30     # due to a bug in PPI it cannot determine the encoding of a source file by
  31     # use utf8; normaly this would be no problem but some people instist on
  32     # putting strange stuff into the source. as a workaround read in the source
  33     # with :utf8 layer and pass it to PPI by reference
  34     # there are still some latin chars, but it's not the purpose of this test
  35     # to find them, so warnings about it will be ignored
  36     local $^W = 0; # don't care about invalid chars in comments
  37     local $/ = undef;
  38     open my $fh, '<:utf8', $file or die $!;
  39     $source = <$fh>;
  40   }
  41
  42   my $doc = PPI::Document->new(\$source) or do {
  43     print $fh "?: PPI error for file $file: " . PPI::Document::errstr() . "\n";
  44     ok 0, $file;
  45     next;
  46   };
  47   my $stmts = $doc->find('Statement::Variable');
  48
  49   for my $var (@{ $stmts || [] }) {
  50     # local can have valid uses like this, and our is extremely uncommon
  51     next unless $var->type eq 'my';
  52
  53     # no if? alright
  54     next unless $var->find(sub { $_[1]->content eq 'if' });
  55
  56     # token "if" is not in the top level struvture - no problem
  57     # most likely an anonymous sub or a complicated map/grep/reduce
  58     next unless grep { $_->content eq 'if'  } $var->schildren;
  59
  60     $clean = 0;
  61     print $fh "?: $var \n";
  62   }
  63
  64   ok $clean, $file;
  65 }