t/t93podcover.t

   1 #!perl -w
   2 use strict;
   3 use lib 't';
   4 use Test::More;
   5 use ExtUtils::Manifest qw(maniread);
   6 #sub Pod::Coverage::TRACE_ALL() { 1 }
   7 eval "use Test::Pod::Coverage 1.08;";
   8 # 1.08 required for coverage_class support
   9 plan skip_all => "Test::Pod::Coverage 1.08 required for POD coverage" if $@;
  10
  11 # scan for a list of files to get Imager method documentation from
  12 my $manifest = maniread();
  13 my @pods = ( 'Imager.pm', grep /\.pod$/, keys %$manifest );
  14
  15 my @private =
  16   (
  17    '^io?_',
  18    '^DSO_',
  19    '^Inline$',
  20    '^yatf$',
  21    '^malloc_state$',
  22    '^init_log$',
  23    '^polybezier$', # not ready for public consumption
  24    '^border$', # I don't know what it is, expect it to go away
  25   );
  26 my @trustme = ( '^open$',  );
  27
  28 plan tests => 20;
  29
  30 {
  31   pod_coverage_ok('Imager', { also_private => \@private,
  32                               pod_from => \@pods,
  33                               trustme => \@trustme,
  34                               coverage_class => 'Pod::Coverage::Imager' });
  35   pod_coverage_ok('Imager::Font');
  36   my @color_private = ( '^i_', '_internal$' );
  37   pod_coverage_ok('Imager::Color',
  38                   { also_private => \@color_private });
  39   pod_coverage_ok('Imager::Color::Float',
  40                   { also_private => \@color_private });
  41   pod_coverage_ok('Imager::Color::Table');
  42   pod_coverage_ok('Imager::ExtUtils');
  43   pod_coverage_ok('Imager::Expr');
  44   my $trust_parents = { coverage_class => 'Pod::Coverage::CountParents' };
  45   pod_coverage_ok('Imager::Expr::Assem', $trust_parents);
  46   pod_coverage_ok('Imager::Fill');
  47   pod_coverage_ok('Imager::Font::BBox');
  48   pod_coverage_ok('Imager::Font::Wrap');
  49   pod_coverage_ok('Imager::Fountain');
  50   pod_coverage_ok('Imager::Matrix2d');
  51   pod_coverage_ok('Imager::Regops');
  52   pod_coverage_ok('Imager::Transform');
  53   pod_coverage_ok('Imager::Test');
  54   pod_coverage_ok('Imager::IO',
  55                   {
  56                    pod_from => "lib/Imager/IO.pod",
  57                    coverage_class => "Pod::Coverage::Imager",
  58                    module => "Imager",
  59                   });
  60 }
  61
  62 {
  63   # check all documented methods/functions are in the method index
  64   my $coverage =
  65     Pod::Coverage::Imager->new(package => 'Imager',
  66                                pod_from => \@pods,
  67                                trustme => \@trustme,
  68                                also_private => \@private);
  69   my %methods = map { $_ => 1 } $coverage->covered;
  70   open IMAGER, "< Imager.pm"
  71     or die "Cannot open Imager.pm: $!";
  72   while (<IMAGER>) {
  73     last if /^=head1 METHOD INDEX/;
  74   }
  75   my @indexed;
  76   my @unknown_indexed;
  77   while (<IMAGER>) {
  78     last if /^=\w/ && !/^=for\b/;
  79
  80     if (/^(\w+)\(/) {
  81       push @indexed, $1;
  82       unless (delete $methods{$1}) {
  83         push @unknown_indexed, $1;
  84       }
  85     }
  86   }
  87
  88   unless (is(keys %methods, 0, "all methods in method index")) {
  89     diag "the following methods are documented but not in the index:";
  90     diag $_ for sort keys %methods;
  91   }
  92   unless (is(@unknown_indexed, 0, "only methods in method index")) {
  93     diag "the following names are in the method index but not documented";
  94     diag $_ for sort @unknown_indexed;
  95   }
  96
  97   sub dict_cmp_func;
  98   is_deeply(\@indexed, [ sort dict_cmp_func @indexed ],
  99             "check method index is alphabetically sorted");
 100 }
 101
 102 sub dict_cmp_func {
 103   (my $tmp_a = lc $a) =~ tr/_//d;
 104   (my $tmp_b = lc $b) =~ tr/_//d;
 105
 106   $tmp_a cmp $tmp_b;
 107 }