lib/Pod/t/pod-spelling.t

   1 #!/usr/bin/perl
   2 #
   3 # t/pod-spelling.t -- Test POD spelling.
   4
   5 # Called to skip all tests with a reason.
   6 sub skip_all {
   7     print "1..1\n";
   8     print "ok 1 # skip - @_\n";
   9     exit;
  10 }
  11
  12 # Make sure we have prerequisites.  hunspell is currently not supported due to
  13 # lack of support for contractions.
  14 eval 'use Test::Pod 1.00';
  15 skip_all "Test::Pod 1.00 required for testing POD" if $@;
  16 eval 'use Pod::Spell';
  17 skip_all "Pod::Spell required to test POD spelling" if $@;
  18 my @spell;
  19 my %options = (aspell => [ qw(-d en_US --home-dir=./ list) ],
  20                ispell => [ qw(-d american -l -p /dev/null) ]);
  21 SEARCH: for my $program (qw/aspell ispell/) {
  22     for my $dir (split ':', $ENV{PATH}) {
  23         if (-x "$dir/$program") {
  24             @spell = ("$dir/$program", @{ $options{$program} });
  25         }
  26         last SEARCH if @spell;
  27     }
  28 }
  29 skip_all "aspell or ispell required to test POD spelling" unless @spell;
  30
  31 # Run the test, one for each POD file.
  32 $| = 1;
  33 my @pod = all_pod_files ();
  34 my $count = scalar @pod;
  35 print "1..$count\n";
  36 my $n = 1;
  37 for my $pod (@pod) {
  38     my $child = open (CHILD, '-|');
  39     if (not defined $child) {
  40         die "Cannot fork: $!\n";
  41     } elsif ($child == 0) {
  42         my $pid = open (SPELL, '|-', @spell)
  43             or die "Cannot run @spell: $!\n";
  44         open (POD, '<', $pod) or die "Cannot open $pod: $!\n";
  45         my $parser = Pod::Spell->new;
  46         $parser->parse_from_filehandle (\*POD, \*SPELL);
  47         close POD;
  48         close SPELL;
  49         exit ($? >> 8);
  50     } else {
  51         my @words = <CHILD>;
  52         close CHILD;
  53         if ($? != 0) {
  54             print "ok $n # skip - @spell failed: $?\n";
  55         } elsif (@words) {
  56             for (@words) {
  57                 s/^\s+//;
  58                 s/\s+$//;
  59             }
  60             print "not ok $n\n";
  61             print " - Misspelled words found in $pod\n";
  62             print "   @words\n";
  63         } else {
  64             print "ok $n\n";
  65         }
  66         $n++;
  67     }
  68 }