130 lines
3.4 KiB
Perl
130 lines
3.4 KiB
Perl
package TestPodChecker;
|
|
|
|
BEGIN {
|
|
use File::Basename;
|
|
use File::Spec;
|
|
push @INC, '..';
|
|
my $THISDIR = dirname $0;
|
|
unshift @INC, $THISDIR;
|
|
require "testcmp.pl";
|
|
import TestCompare;
|
|
my $PARENTDIR = dirname $THISDIR;
|
|
push @INC, map { File::Spec->catfile($_, 'lib') } ($PARENTDIR, $THISDIR);
|
|
require VMS::Filespec if $^O eq 'VMS';
|
|
}
|
|
|
|
use Pod::Checker;
|
|
use vars qw(@ISA @EXPORT $MYPKG);
|
|
#use strict;
|
|
#use diagnostics;
|
|
use Carp;
|
|
use Exporter;
|
|
#use File::Compare;
|
|
|
|
@ISA = qw(Exporter);
|
|
@EXPORT = qw(&testpodchecker);
|
|
$MYPKG = eval { (caller)[0] };
|
|
|
|
sub stripname( $ ) {
|
|
local $_ = shift;
|
|
return /(\w[.\w]*)\s*$/ ? $1 : $_;
|
|
}
|
|
|
|
sub msgcmp( $ $ ) {
|
|
## filter out platform-dependent aspects of error messages
|
|
my ($line1, $line2) = @_;
|
|
for ($line1, $line2) {
|
|
## remove filenames from error messages to avoid any
|
|
## filepath naming differences between OS platforms
|
|
s/(at line \S+ in file) .*\W(\w+\.[tT])\s*$/$1 \L$2\E/;
|
|
s/.*\W(\w+\.[tT]) (has \d+ pod syntax error)/\L$1\E $2/;
|
|
}
|
|
return ($line1 ne $line2);
|
|
}
|
|
|
|
sub testpodcheck( @ ) {
|
|
my %args = @_;
|
|
my $infile = $args{'-In'} || croak "No input file given!";
|
|
my $outfile = $args{'-Out'} || croak "No output file given!";
|
|
my $cmpfile = $args{'-Cmp'} || croak "No compare-result file given!";
|
|
|
|
my $different = '';
|
|
my $testname = basename $cmpfile, '.t', '.xr';
|
|
|
|
unless (-e $cmpfile) {
|
|
my $msg = "*** Can't find comparison file $cmpfile for testing $infile";
|
|
warn "$msg\n";
|
|
return $msg;
|
|
}
|
|
|
|
print "# Running podchecker for '$testname'...\n";
|
|
## Compare the output against the expected result
|
|
if ($^O eq 'VMS') {
|
|
for ($infile, $outfile, $cmpfile) {
|
|
$_ = VMS::Filespec::unixify($_) unless ref;
|
|
}
|
|
}
|
|
podchecker($infile, $outfile);
|
|
if ( testcmp({'-cmplines' => \&msgcmp}, $outfile, $cmpfile) ) {
|
|
$different = "$outfile is different from $cmpfile";
|
|
}
|
|
else {
|
|
unlink($outfile);
|
|
}
|
|
return $different;
|
|
}
|
|
|
|
sub testpodchecker( @ ) {
|
|
my %opts = (ref $_[0] eq 'HASH') ? %{shift()} : ();
|
|
my @testpods = @_;
|
|
my ($testname, $testdir) = ("", "");
|
|
my ($podfile, $cmpfile) = ("", "");
|
|
my ($outfile, $errfile) = ("", "");
|
|
my $passes = 0;
|
|
my $failed = 0;
|
|
local $_;
|
|
|
|
print "1..", scalar @testpods, "\n" unless ($opts{'-xrgen'});
|
|
|
|
for $podfile (@testpods) {
|
|
($testname, $_) = fileparse($podfile);
|
|
$testdir ||= $_;
|
|
$testname =~ s/\.t$//;
|
|
$cmpfile = $testdir . $testname . '.xr';
|
|
$outfile = $testdir . $testname . '.OUT';
|
|
|
|
if ($opts{'-xrgen'}) {
|
|
if ($opts{'-force'} or ! -e $cmpfile) {
|
|
## Create the comparison file
|
|
print "# Creating expected result for \"$testname\"" .
|
|
" podchecker test ...\n";
|
|
podchecker($podfile, $cmpfile);
|
|
}
|
|
else {
|
|
print "# File $cmpfile already exists" .
|
|
" (use '-force' to regenerate it).\n";
|
|
}
|
|
next;
|
|
}
|
|
|
|
my $failmsg = testpodcheck
|
|
-In => $podfile,
|
|
-Out => $outfile,
|
|
-Cmp => $cmpfile;
|
|
if ($failmsg) {
|
|
++$failed;
|
|
print "#\tFAILED. ($failmsg)\n";
|
|
print "not ok ", $failed+$passes, "\n";
|
|
}
|
|
else {
|
|
++$passes;
|
|
unlink($outfile);
|
|
print "#\tPASSED.\n";
|
|
print "ok ", $failed+$passes, "\n";
|
|
}
|
|
}
|
|
return $passes;
|
|
}
|
|
|
|
1;
|