1 package TestPodChecker;
7 my $THISDIR = dirname $0;
8 unshift @INC, $THISDIR;
11 my $PARENTDIR = dirname $THISDIR;
12 push @INC, map { File::Spec->catfile($_, 'lib') } ($PARENTDIR, $THISDIR);
16 use vars qw(@ISA @EXPORT $MYPKG);
24 @EXPORT = qw(&testpodchecker);
25 $MYPKG = eval { (caller)[0] };
29 return /(\w[.\w]*)\s*$/ ? $1 : $_;
33 ## filter out platform-dependent aspects of error messages
34 my ($line1, $line2) = @_;
35 for ($line1, $line2) {
36 if ( /^#*\s*(\S.*?)\s+(?:has \d+\s*)?pod syntax (?:error|OK)/ ) {
38 s/^#*\s*// if ($^O eq 'MacOS');
39 s/^\s*\Q$fname\E/stripname($fname)/e;
41 elsif ( /^#*\s*\*+\s*(?:ERROR|Unterminated)/ ) {
42 s/^#*\s*// if ($^O eq 'MacOS');
43 s/of file\s+(\S.*?)\s*$/"of file ".stripname($1)/e;
44 s/at\s+(\S.*?)\s+line/"at ".stripname($1)." line"/e;
47 return $line1 ne $line2;
50 sub testpodcheck( @ ) {
52 my $infile = $args{'-In'} || croak "No input file given!";
53 my $outfile = $args{'-Out'} || croak "No output file given!";
54 my $cmpfile = $args{'-Cmp'} || croak "No compare-result file given!";
57 my $testname = basename $cmpfile, '.t', '.xr';
59 unless (-e $cmpfile) {
60 my $msg = "*** Can't find comparison file $cmpfile for testing $infile";
65 print "# Running podchecker for '$testname'...\n";
66 ## Compare the output against the expected result
67 podchecker($infile, $outfile);
68 if ( testcmp({'-cmplines' => \&msgcmp}, $outfile, $cmpfile) ) {
69 $different = "$outfile is different from $cmpfile";
77 sub testpodchecker( @ ) {
78 my %opts = (ref $_[0] eq 'HASH') ? %{shift()} : ();
80 my ($testname, $testdir) = ("", "");
81 my ($podfile, $cmpfile) = ("", "");
82 my ($outfile, $errfile) = ("", "");
87 print "1..", scalar @testpods, "\n" unless ($opts{'-xrgen'});
89 for $podfile (@testpods) {
90 ($testname, $_) = fileparse($podfile);
92 $testname =~ s/\.t$//;
93 $cmpfile = $testdir . $testname . '.xr';
94 $outfile = $testdir . $testname . '.OUT';
96 if ($opts{'-xrgen'}) {
97 if ($opts{'-force'} or ! -e $cmpfile) {
98 ## Create the comparison file
99 print "# Creating expected result for \"$testname\"" .
100 " podchecker test ...\n";
101 podchecker($podfile, $cmpfile);
104 print "# File $cmpfile already exists" .
105 " (use '-force' to regenerate it).\n";
110 my $failmsg = testpodcheck
116 print "#\tFAILED. ($failmsg)\n";
117 print "not ok ", $failed+$passes, "\n";
122 print "#\tPASSED.\n";
123 print "ok ", $failed+$passes, "\n";