This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
07236e69e778d934803ea2ff9823c6af8d69abcf
[perl5.git] / t / pod / testpchk.pl
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
65    print "# Running podchecker for '$testname'...\n";
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
99              print "# Creating expected result for \"$testname\"" .
100                    " podchecker test ...\n";
101              podchecker($podfile, $cmpfile);
102           }
103           else {
104              print "# File $cmpfile already exists" .
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;
116           print "#\tFAILED. ($failmsg)\n";
117           print "not ok ", $failed+$passes, "\n";
118       }
119       else {
120           ++$passes;
121           unlink($outfile);
122           print "#\tPASSED.\n";
123           print "ok ", $failed+$passes, "\n";
124       }
125    }
126    return  $passes;
127 }
128
129 1;