This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Incremental Mac integration from Matthias.
[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    my ($line1, $line2) = @_;
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
52    print "# Running podchecker for '$testname'...\n";
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
86              print "# Creating expected result for \"$testname\"" .
87                    " podchecker test ...\n";
88              podchecker($podfile, $cmpfile);
89           }
90           else {
91              print "# File $cmpfile already exists" .
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;
103           print "#\tFAILED. ($failmsg)\n";
104           print "not ok ", $failed+$passes, "\n";
105       }
106       else {
107           ++$passes;
108           unlink($outfile);
109           print "#\tPASSED.\n";
110           print "ok ", $failed+$passes, "\n";
111       }
112    }
113    return  $passes;
114 }
115
116 1;