Avoid negating an unsigned value. (The offset in the SV body table)
[p5sagit/p5-mst-13.2.git] / t / pod / testpchk.pl
CommitLineData
360aca43 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);
828c4421 13 require VMS::Filespec if $^O eq 'VMS';
360aca43 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( $ $ ) {
828c4421 34 ## filter out platform-dependent aspects of error messages
360aca43 35 my ($line1, $line2) = @_;
828c4421 36 for ($line1, $line2) {
564d657a 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/;
828c4421 41 }
564d657a 42 return ($line1 ne $line2);
360aca43 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
27f805f4 60 print "# Running podchecker for '$testname'...\n";
360aca43 61 ## Compare the output against the expected result
828c4421 62 if ($^O eq 'VMS') {
63 for ($infile, $outfile, $cmpfile) {
64 $_ = VMS::Filespec::unixify($_) unless ref;
65 }
66 }
360aca43 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
27f805f4 99 print "# Creating expected result for \"$testname\"" .
360aca43 100 " podchecker test ...\n";
101 podchecker($podfile, $cmpfile);
102 }
103 else {
27f805f4 104 print "# File $cmpfile already exists" .
360aca43 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;
27f805f4 116 print "#\tFAILED. ($failmsg)\n";
360aca43 117 print "not ok ", $failed+$passes, "\n";
118 }
119 else {
120 ++$passes;
121 unlink($outfile);
27f805f4 122 print "#\tPASSED.\n";
360aca43 123 print "ok ", $failed+$passes, "\n";
124 }
125 }
126 return $passes;
127}
128
1291;