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;
## 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;
- }
+ ## 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;
+ return ($line1 ne $line2);
}
sub testpodcheck( @ ) {
return $msg;
}
- print "+ Running podchecker for '$testname'...\n";
+ 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";
if ($opts{'-xrgen'}) {
if ($opts{'-force'} or ! -e $cmpfile) {
## Create the comparison file
- print "+ Creating expected result for \"$testname\"" .
+ print "# Creating expected result for \"$testname\"" .
" podchecker test ...\n";
podchecker($podfile, $cmpfile);
}
else {
- print "+ File $cmpfile already exists" .
+ print "# File $cmpfile already exists" .
" (use '-force' to regenerate it).\n";
}
next;
-Cmp => $cmpfile;
if ($failmsg) {
++$failed;
- print "+\tFAILED. ($failmsg)\n";
+ print "#\tFAILED. ($failmsg)\n";
print "not ok ", $failed+$passes, "\n";
}
else {
++$passes;
unlink($outfile);
- print "+\tPASSED.\n";
+ print "#\tPASSED.\n";
print "ok ", $failed+$passes, "\n";
}
}