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$MYPKG = eval { (caller)[0] }; 27 28sub stripname( $ ) { 29 local $_ = shift; 30 return /(\w[.\w]*)\s*$/ ? $1 : $_; 31} 32 33sub msgcmp( $ $ ) { 34 ## filter out platform-dependent aspects of error messages 35 my ($line1, $line2) = @_; 36 for ($line1, $line2) { 37 ## remove filenames from error messages to avoid any 38 ## filepath naming differences between OS platforms 39 s/(at line \S+ in file) .*\W(\w+\.[tT])\s*$/$1 \L$2\E/; 40 s/.*\W(\w+\.[tT]) (has \d+ pod syntax error)/\L$1\E $2/; 41 } 42 return ($line1 ne $line2); 43} 44 45sub testpodcheck( @ ) { 46 my %args = @_; 47 my $infile = $args{'-In'} || croak "No input file given!"; 48 my $outfile = $args{'-Out'} || croak "No output file given!"; 49 my $cmpfile = $args{'-Cmp'} || croak "No compare-result file given!"; 50 51 my $different = ''; 52 my $testname = basename $cmpfile, '.t', '.xr'; 53 54 unless (-e $cmpfile) { 55 my $msg = "*** Can't find comparison file $cmpfile for testing $infile"; 56 warn "$msg\n"; 57 return $msg; 58 } 59 60 print "# Running podchecker for '$testname'...\n"; 61 ## Compare the output against the expected result 62 if ($^O eq 'VMS') { 63 for ($infile, $outfile, $cmpfile) { 64 $_ = VMS::Filespec::unixify($_) unless ref; 65 } 66 } 67 podchecker($infile, $outfile); 68 if ( testcmp({'-cmplines' => \&msgcmp}, $outfile, $cmpfile) ) { 69 $different = "$outfile is different from $cmpfile"; 70 } 71 else { 72 unlink($outfile); 73 } 74 return $different; 75} 76 77sub testpodchecker( @ ) { 78 my %opts = (ref $_[0] eq 'HASH') ? %{shift()} : (); 79 my @testpods = @_; 80 my ($testname, $testdir) = ("", ""); 81 my ($podfile, $cmpfile) = ("", ""); 82 my ($outfile, $errfile) = ("", ""); 83 my $passes = 0; 84 my $failed = 0; 85 local $_; 86 87 print "1..", scalar @testpods, "\n" unless ($opts{'-xrgen'}); 88 89 for $podfile (@testpods) { 90 ($testname, $_) = fileparse($podfile); 91 $testdir ||= $_; 92 $testname =~ s/\.t$//; 93 $cmpfile = $testdir . $testname . '.xr'; 94 $outfile = $testdir . $testname . '.OUT'; 95 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); 102 } 103 else { 104 print "# File $cmpfile already exists" . 105 " (use '-force' to regenerate it).\n"; 106 } 107 next; 108 } 109 110 my $failmsg = testpodcheck 111 -In => $podfile, 112 -Out => $outfile, 113 -Cmp => $cmpfile; 114 if ($failmsg) { 115 ++$failed; 116 print "#\tFAILED. ($failmsg)\n"; 117 print "not ok ", $failed+$passes, "\n"; 118 } 119 else { 120 ++$passes; 121 unlink($outfile); 122 print "#\tPASSED.\n"; 123 print "ok ", $failed+$passes, "\n"; 124 } 125 } 126 return $passes; 127} 128 1291; 130