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