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( $ $ ) { |
360aca43 |
33 | my ($line1, $line2) = @_; |
360aca43 |
34 | return $line1 ne $line2; |
35 | } |
36 | |
37 | sub testpodcheck( @ ) { |
38 | my %args = @_; |
39 | my $infile = $args{'-In'} || croak "No input file given!"; |
40 | my $outfile = $args{'-Out'} || croak "No output file given!"; |
41 | my $cmpfile = $args{'-Cmp'} || croak "No compare-result file given!"; |
42 | |
43 | my $different = ''; |
44 | my $testname = basename $cmpfile, '.t', '.xr'; |
45 | |
46 | unless (-e $cmpfile) { |
47 | my $msg = "*** Can't find comparison file $cmpfile for testing $infile"; |
48 | warn "$msg\n"; |
49 | return $msg; |
50 | } |
51 | |
146174a9 |
52 | print "# Running podchecker for '$testname'...\n"; |
360aca43 |
53 | ## Compare the output against the expected result |
54 | podchecker($infile, $outfile); |
55 | if ( testcmp({'-cmplines' => \&msgcmp}, $outfile, $cmpfile) ) { |
56 | $different = "$outfile is different from $cmpfile"; |
57 | } |
58 | else { |
59 | unlink($outfile); |
60 | } |
61 | return $different; |
62 | } |
63 | |
64 | sub testpodchecker( @ ) { |
65 | my %opts = (ref $_[0] eq 'HASH') ? %{shift()} : (); |
66 | my @testpods = @_; |
67 | my ($testname, $testdir) = ("", ""); |
68 | my ($podfile, $cmpfile) = ("", ""); |
69 | my ($outfile, $errfile) = ("", ""); |
70 | my $passes = 0; |
71 | my $failed = 0; |
72 | local $_; |
73 | |
74 | print "1..", scalar @testpods, "\n" unless ($opts{'-xrgen'}); |
75 | |
76 | for $podfile (@testpods) { |
77 | ($testname, $_) = fileparse($podfile); |
78 | $testdir ||= $_; |
79 | $testname =~ s/\.t$//; |
80 | $cmpfile = $testdir . $testname . '.xr'; |
81 | $outfile = $testdir . $testname . '.OUT'; |
82 | |
83 | if ($opts{'-xrgen'}) { |
84 | if ($opts{'-force'} or ! -e $cmpfile) { |
85 | ## Create the comparison file |
146174a9 |
86 | print "# Creating expected result for \"$testname\"" . |
360aca43 |
87 | " podchecker test ...\n"; |
88 | podchecker($podfile, $cmpfile); |
89 | } |
90 | else { |
146174a9 |
91 | print "# File $cmpfile already exists" . |
360aca43 |
92 | " (use '-force' to regenerate it).\n"; |
93 | } |
94 | next; |
95 | } |
96 | |
97 | my $failmsg = testpodcheck |
98 | -In => $podfile, |
99 | -Out => $outfile, |
100 | -Cmp => $cmpfile; |
101 | if ($failmsg) { |
102 | ++$failed; |
146174a9 |
103 | print "#\tFAILED. ($failmsg)\n"; |
360aca43 |
104 | print "not ok ", $failed+$passes, "\n"; |
105 | } |
106 | else { |
107 | ++$passes; |
108 | unlink($outfile); |
146174a9 |
109 | print "#\tPASSED.\n"; |
360aca43 |
110 | print "ok ", $failed+$passes, "\n"; |
111 | } |
112 | } |
113 | return $passes; |
114 | } |
115 | |
116 | 1; |