vcs.maemo.org Git - dh-make-perl/blob - dev/i386/libperl-critic-perl/libperl-critic-perl-1.088/xt/author/94_includes.t

   1 #!perl
   2
   3 use warnings;
   4 use strict;
   5
   6 use Test::More;
   7
   8 use File::Find;
   9 use PPI::Document;
  10
  11 my %implied = (
  12     # Universal
  13     SUPER => 1,
  14
  15     'Readonly::Scalar' => 'Readonly',
  16     'Readonly::Array' => 'Readonly',
  17     'Readonly::Hash' => 'Readonly',
  18 );
  19
  20
  21 my @pm;
  22 find(
  23     {
  24         wanted => sub { push @pm, $_ if m/\.pm \z/xms && !m/svn/xms },
  25         no_chdir => 1,
  26     },
  27     'lib'
  28 );
  29 plan tests => scalar @pm;
  30
  31 for my $file (@pm) {
  32     SKIP:
  33     {
  34         my $doc = PPI::Document->new($file) || die 'Failed to parse '.$file;
  35
  36         my @incs = @{$doc->find('PPI::Statement::Include') || []};
  37         my %deps = map {$_->module => 1} grep {$_->type eq 'use' || $_->type eq 'require'} @incs;
  38         my %thispkg = map {$_->namespace => 1} @{$doc->find('PPI::Statement::Package') || []};
  39         my @pkgs = @{$doc->find('PPI::Token::Word')};
  40         my %failed;
  41
  42         for my $pkg (@pkgs) {
  43             my $name = "$pkg";
  44             next if $name !~ m/::/xms;
  45             next if $name =~ m/::_private::/xms;
  46             next if $name =~ m/List::Util::[a-z]+/xms;
  47
  48             # subroutine declaration with absolute name?
  49             # (bad form, but legal)
  50             my $prev_sib = $pkg->sprevious_sibling;
  51             next if ($prev_sib &&
  52                      $prev_sib eq 'sub' &&
  53                      !$prev_sib->sprevious_sibling &&
  54                      $pkg->parent->isa('PPI::Statement::Sub'));
  55
  56             my $token = $pkg->next_sibling;
  57
  58             if ($token =~ m/\A \(/xms) {
  59                 $name =~ s/::\w+\z//xms;
  60             }
  61
  62             if ( !match($name, \%deps, \%thispkg) ) {
  63                 $failed{$name} = 1;
  64             }
  65         }
  66
  67         my @failures = sort keys %failed;
  68         if (@failures) {
  69             diag("found deps @{[sort keys %deps]}");
  70             diag("Missed @failures");
  71         }
  72         ok(@failures == 0, $file);
  73     }
  74 }
  75
  76 sub match {
  77     my $pkg = shift;
  78     my $deps = shift;
  79     my $thispkg = shift;
  80
  81     return 1 if $thispkg->{$pkg};
  82     return 1 if $deps->{$pkg};
  83     $pkg = $implied{$pkg};
  84     return 0 if !defined $pkg;
  85     return 1 if 1 eq $pkg;
  86     return match($pkg, $deps, $thispkg);
  87 }
  88
  89 #-----------------------------------------------------------------------------
  90
  91 # ensure we run true if this test is loaded by
  92 # t/94_includes.t.t.without_optional_dependencies.t
  93 1;
  94
  95 # Local Variables:
  96 #   mode: cperl
  97 #   cperl-indent-level: 4
  98 #   fill-column: 78
  99 #   indent-tabs-mode: nil
 100 #   c-indentation-style: bsd
 101 # End:
 102 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :