Commit | Line | Data |
360aca43 |
1 | package TestPodChecker; |
2 | |
3 | BEGIN { |
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 | } |
14 | |
15 | use Pod::Checker; |
16 | use vars qw(@ISA @EXPORT $MYPKG); |
17 | #use strict; |
18 | #use diagnostics; |
19 | use Carp; |
20 | use Exporter; |
21 | #use File::Compare; |
22 | |
23 | @ISA = qw(Exporter); |
24 | @EXPORT = qw(&testpodchecker); |
25 | $MYPKG = eval { (caller)[0] }; |
26 | |
27 | sub stripname( $ ) { |
28 | local $_ = shift; |
29 | return /(\w[.\w]*)\s*$/ ? $1 : $_; |
30 | } |
31 | |
32 | sub msgcmp( $ $ ) { |
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)/ ) { |
37 | my $fname = $1; |
38 | s/^#*\s*// if ($^O eq 'MacOS'); |
39 | s/^\s*\Q$fname\E/stripname($fname)/e; |
40 | } |
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; |
45 | } |
46 | } |
47 | return $line1 ne $line2; |
48 | } |
49 | |
50 | sub testpodcheck( @ ) { |
51 | my %args = @_; |
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!"; |
55 | |
56 | my $different = ''; |
57 | my $testname = basename $cmpfile, '.t', '.xr'; |
58 | |
59 | unless (-e $cmpfile) { |
60 | my $msg = "*** Can't find comparison file $cmpfile for testing $infile"; |
61 | warn "$msg\n"; |
62 | return $msg; |
63 | } |
64 | |
27f805f4 |
65 | print "# Running podchecker for '$testname'...\n"; |
360aca43 |
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"; |
70 | } |
71 | else { |
72 | unlink($outfile); |
73 | } |
74 | return $different; |
75 | } |
76 | |
77 | sub 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 | |
129 | 1; |