1package TestPodChecker;
2
3BEGIN {
4   use File::Basename;
5   use File::Spec;
6   push @INC, '..';
7   my $THISDIR = dirname $0;
8   unshift @INC, $THISDIR;
9   require "testcmp.pl";
10   import TestCompare;
11   my $PARENTDIR = dirname $THISDIR;
12   push @INC, map { File::Spec->catfile($_, 'lib') } ($PARENTDIR, $THISDIR);
13   require VMS::Filespec if $^O eq 'VMS';
14}
15
16use Pod::Checker;
17use vars qw(@ISA @EXPORT $MYPKG);
18#use strict;
19#use diagnostics;
20use Carp;
21use Exporter;
22#use File::Compare;
23
24@ISA = qw(Exporter);
25@EXPORT = qw(&testpodchecker);
26@EXPORT_OK = qw(&testpodcheck);
27$MYPKG = eval { (caller)[0] };
28
29sub stripname( $ ) {
30   local $_ = shift;
31   return /(\w[.\w]*)\s*$/ ? $1 : $_;
32}
33
34sub msgcmp( $ $ ) {
35   ## filter out platform-dependent aspects of error messages
36   my ($line1, $line2) = @_;
37   for ($line1, $line2) {
38      ## remove filenames from error messages to avoid any
39      ## filepath naming differences between OS platforms
40      s/(at line \S+ in file) .*\W(\w+\.[tT])\s*$/$1 \L$2\E/;
41      s/.*\W(\w+\.[tT]) (has \d+ pod syntax error)/\L$1\E $2/;
42   }
43   return ($line1 ne $line2);
44}
45
46sub testpodcheck( @ ) {
47   my %args = @_;
48   my $infile  = $args{'-In'}  || croak "No input file given!";
49   my $outfile = $args{'-Out'} || croak "No output file given!";
50   my $cmpfile = $args{'-Cmp'} || croak "No compare-result file given!";
51
52   my $different = '';
53   my $testname = basename $infile, '.t', '.xr';
54
55   unless (-e $cmpfile) {
56      my $msg = "*** Can't find comparison file $cmpfile for testing $infile";
57      warn  "$msg\n";
58      return  $msg;
59   }
60
61   print "# Running podchecker for '$testname'...\n";
62   ## Compare the output against the expected result
63   if ($^O eq 'VMS') {
64      for ($infile, $outfile, $cmpfile) {
65         $_ = VMS::Filespec::unixify($_)  unless  ref;
66      }
67   }
68   podchecker($infile, $outfile);
69   if ( testcmp({'-cmplines' => \&msgcmp}, $outfile, $cmpfile) ) {
70       $different = "$outfile is different from $cmpfile";
71   }
72   else {
73       unlink($outfile);
74   }
75   return  $different;
76}
77
78sub testpodchecker( @ ) {
79   my %opts = (ref $_[0] eq 'HASH') ? %{shift()} : ();
80   my @testpods = @_;
81   my ($testname, $testdir) = ("", "");
82   my ($podfile, $cmpfile) = ("", "");
83   my ($outfile, $errfile) = ("", "");
84   my $passes = 0;
85   my $failed = 0;
86   local $_;
87
88   print "1..", scalar @testpods, "\n"  unless ($opts{'-xrgen'});
89
90   for $podfile (@testpods) {
91      ($testname, $_) = fileparse($podfile);
92      $testdir ||=  $_;
93      $testname  =~ s/\.t$//;
94      $cmpfile   =  $testdir . $testname . '.xr';
95      $outfile   =  $testdir . $testname . '.OUT';
96
97      if ($opts{'-xrgen'}) {
98          if ($opts{'-force'} or ! -e $cmpfile) {
99             ## Create the comparison file
100             print "# Creating expected result for \"$testname\"" .
101                   " podchecker test ...\n";
102             podchecker($podfile, $cmpfile);
103          }
104          else {
105             print "# File $cmpfile already exists" .
106                   " (use '-force' to regenerate it).\n";
107          }
108          next;
109      }
110
111      my $failmsg = testpodcheck
112                        -In  => $podfile,
113                        -Out => $outfile,
114                        -Cmp => $cmpfile;
115      if ($failmsg) {
116          ++$failed;
117          print "#\tFAILED. ($failmsg)\n";
118	  print "not ok ", $failed+$passes, "\n";
119      }
120      else {
121          ++$passes;
122          unlink($outfile);
123          print "#\tPASSED.\n";
124	  print "ok ", $failed+$passes, "\n";
125      }
126   }
127   return  $passes;
128}
129
1301;
131