Commit | Line | Data |
---|---|---|
360aca43 GS |
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); | |
828c4421 | 13 | require VMS::Filespec if $^O eq 'VMS'; |
360aca43 GS |
14 | } |
15 | ||
16 | use Pod::Checker; | |
17 | use vars qw(@ISA @EXPORT $MYPKG); | |
18 | #use strict; | |
19 | #use diagnostics; | |
20 | use Carp; | |
21 | use Exporter; | |
22 | #use File::Compare; | |
23 | ||
24 | @ISA = qw(Exporter); | |
25 | @EXPORT = qw(&testpodchecker); | |
26 | $MYPKG = eval { (caller)[0] }; | |
27 | ||
28 | sub stripname( $ ) { | |
29 | local $_ = shift; | |
30 | return /(\w[.\w]*)\s*$/ ? $1 : $_; | |
31 | } | |
32 | ||
33 | sub msgcmp( $ $ ) { | |
828c4421 | 34 | ## filter out platform-dependent aspects of error messages |
360aca43 | 35 | my ($line1, $line2) = @_; |
828c4421 | 36 | for ($line1, $line2) { |
564d657a GS |
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 GS |
43 | } |
44 | ||
45 | sub 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 GS |
62 | if ($^O eq 'VMS') { |
63 | for ($infile, $outfile, $cmpfile) { | |
64 | $_ = VMS::Filespec::unixify($_) unless ref; | |
65 | } | |
66 | } | |
360aca43 GS |
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 GS |
100 | " podchecker test ...\n"; |
101 | podchecker($podfile, $cmpfile); | |
102 | } | |
103 | else { | |
27f805f4 | 104 | print "# File $cmpfile already exists" . |
360aca43 GS |
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 GS |
117 | print "not ok ", $failed+$passes, "\n"; |
118 | } | |
119 | else { | |
120 | ++$passes; | |
121 | unlink($outfile); | |
27f805f4 | 122 | print "#\tPASSED.\n"; |
360aca43 GS |
123 | print "ok ", $failed+$passes, "\n"; |
124 | } | |
125 | } | |
126 | return $passes; | |
127 | } | |
128 | ||
129 | 1; |