t/structure/double_colon_interpolation.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     local $^W = 0; # don't care about invalid chars in comments
  24     local $/ = undef;
  25     open my $fh, '<:utf8', $file or die $!;
  26     $source = <$fh>;
  27   }
  28
  29   my $doc = PPI::Document->new(\$source) or do {
  30     print "?: PPI error for file $file: " . PPI::Document::errstr() . "\n";
  31     ok 0, $file;
  32     next;
  33   };
  34   my $stmts = $doc->find(sub { $_[1]->isa('PPI::Token::Quote::Double') || $_[1]->isa('PPI::Token::Quote::Interpolate') });
  35
  36   for my $stmt (@{ $stmts || [] }) {
  37     my $content = $stmt->content;
  38
  39     if ($content =~ /(\$\w+::)\$/) {
  40       print "?: @{[ $stmt->content ]} contains $1 \n";
  41       $clean = 0;
  42     }
  43   }
  44
  45   ok $clean, $file;
  46 }
  47
  48 my $pool = Thread::Pool::Simple->new(
  49   min    => 2,
  50   max    => Sys::CPU::cpu_count() + 1,
  51   do     => [ \&test_file ],
  52   passid => 0,
  53 );
  54
  55 $pool->add($_) for @testitems;
  56
  57 $pool->join;