1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
|
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);
}
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) {
if ( /^#*\s*(\S.*?)\s+(?:has \d+\s*)?pod syntax (?:error|OK)/ ) {
my $fname = $1;
s/^#*\s*// if ($^O eq 'MacOS');
s/^\s*\Q$fname\E/stripname($fname)/e;
}
elsif ( /^#*\s*\*+\s*(?:ERROR|Unterminated)/ ) {
s/^#*\s*// if ($^O eq 'MacOS');
s/of file\s+(\S.*?)\s*$/"of file ".stripname($1)/e;
s/at\s+(\S.*?)\s+line/"at ".stripname($1)." line"/e;
}
}
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
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;
|
