integrate cfgperl changes into mainline
[p5sagit/p5-mst-13.2.git] / t / pod / testp2pt.pl
CommitLineData
360aca43 1package TestPodIncPlainText;
2
3BEGIN {
4 use File::Basename;
5 use File::Spec;
e9fdc7d2 6 use Cwd qw(abs_path);
360aca43 7 push @INC, '..';
e9fdc7d2 8 my $THISDIR = abs_path(dirname $0);
360aca43 9 unshift @INC, $THISDIR;
10 require "testcmp.pl";
11 import TestCompare;
12 my $PARENTDIR = dirname $THISDIR;
13 push @INC, map { File::Spec->catfile($_, 'lib') } ($PARENTDIR, $THISDIR);
14}
15
360aca43 16#use strict;
17#use diagnostics;
18use Carp;
19use Exporter;
20#use File::Compare;
e9fdc7d2 21#use Cwd qw(abs_path);
360aca43 22
664bb207 23use vars qw($MYPKG @EXPORT @ISA);
360aca43 24$MYPKG = eval { (caller)[0] };
664bb207 25@EXPORT = qw(&testpodplaintext);
26BEGIN {
27 if ( $] >= 5.005_58 ) {
28 require Pod::Text;
29 @ISA = qw( Pod::Text );
30 }
31 else {
32 require Pod::PlainText;
33 @ISA = qw( Pod::PlainText );
34 }
35}
360aca43 36
37## Hardcode settings for TERMCAP and COLUMNS so we can try to get
38## reproducible results between environments
664bb207 39@ENV{qw(TERMCAP COLUMNS)} = ('co=76:do=^J', 76);
360aca43 40
41sub catfile(@) { File::Spec->catfile(@_); }
42
e9fdc7d2 43my $INSTDIR = abs_path(dirname $0);
44$INSTDIR = (dirname $INSTDIR) if (basename($INSTDIR) eq 'xtra');
45$INSTDIR = (dirname $INSTDIR) if (basename($INSTDIR) eq 'pod');
46$INSTDIR = (dirname $INSTDIR) if (basename($INSTDIR) eq 't');
47my @PODINCDIRS = ( catfile($INSTDIR, 'lib', 'Pod'),
27f805f4 48 catfile($INSTDIR, 'pod'),
e9fdc7d2 49 catfile($INSTDIR, 't', 'pod'),
50 catfile($INSTDIR, 't', 'pod', 'xtra')
51 );
52
360aca43 53## Find the path to the file to =include
54sub findinclude {
55 my $self = shift;
56 my $incname = shift;
57
58 ## See if its already found w/out any "searching;
59 return $incname if (-r $incname);
60
61 ## Need to search for it. Look in the following directories ...
62 ## 1. the directory containing this pod file
63 my $thispoddir = dirname $self->input_file;
64 ## 2. the parent directory of the above
e9fdc7d2 65 my $parentdir = dirname $thispoddir;
66 my @podincdirs = ($thispoddir, $parentdir, @PODINCDIRS);
360aca43 67
68 for (@podincdirs) {
69 my $incfile = catfile($_, $incname);
70 return $incfile if (-r $incfile);
71 }
72 warn("*** Can't find =include file $incname in @podincdirs\n");
73 return "";
74}
75
76sub command {
77 my $self = shift;
78 my ($cmd, $text, $line_num, $pod_para) = @_;
79 $cmd = '' unless (defined $cmd);
80 local $_ = $text || '';
81 my $out_fh = $self->output_handle;
82
83 ## Defer to the superclass for everything except '=include'
84 return $self->SUPER::command(@_) unless ($cmd eq "include");
85
86 ## We have an '=include' command
87 my $incdebug = 1; ## debugging
88 my @incargs = split;
89 if (@incargs == 0) {
90 warn("*** No filename given for '=include'\n");
91 return;
92 }
93 my $incfile = $self->findinclude(shift @incargs) or return;
94 my $incbase = basename $incfile;
95 print $out_fh "###### begin =include $incbase #####\n" if ($incdebug);
96 $self->parse_from_file( {-cutting => 1}, $incfile );
97 print $out_fh "###### end =include $incbase #####\n" if ($incdebug);
98}
99
100sub podinc2plaintext( $ $ ) {
101 my ($infile, $outfile) = @_;
102 local $_;
103 my $text_parser = $MYPKG->new;
104 $text_parser->parse_from_file($infile, $outfile);
105}
106
107sub testpodinc2plaintext( @ ) {
108 my %args = @_;
109 my $infile = $args{'-In'} || croak "No input file given!";
110 my $outfile = $args{'-Out'} || croak "No output file given!";
111 my $cmpfile = $args{'-Cmp'} || croak "No compare-result file given!";
112
113 my $different = '';
114 my $testname = basename $cmpfile, '.t', '.xr';
115
116 unless (-e $cmpfile) {
117 my $msg = "*** Can't find comparison file $cmpfile for testing $infile";
118 warn "$msg\n";
119 return $msg;
120 }
121
27f805f4 122 print "# Running testpodinc2plaintext for '$testname'...\n";
360aca43 123 ## Compare the output against the expected result
124 podinc2plaintext($infile, $outfile);
125 if ( testcmp($outfile, $cmpfile) ) {
126 $different = "$outfile is different from $cmpfile";
127 }
128 else {
129 unlink($outfile);
130 }
131 return $different;
132}
133
134sub testpodplaintext( @ ) {
135 my %opts = (ref $_[0] eq 'HASH') ? %{shift()} : ();
136 my @testpods = @_;
137 my ($testname, $testdir) = ("", "");
138 my ($podfile, $cmpfile) = ("", "");
139 my ($outfile, $errfile) = ("", "");
140 my $passes = 0;
141 my $failed = 0;
142 local $_;
143
144 print "1..", scalar @testpods, "\n" unless ($opts{'-xrgen'});
145
146 for $podfile (@testpods) {
147 ($testname, $_) = fileparse($podfile);
148 $testdir ||= $_;
149 $testname =~ s/\.t$//;
150 $cmpfile = $testdir . $testname . '.xr';
151 $outfile = $testdir . $testname . '.OUT';
152
153 if ($opts{'-xrgen'}) {
154 if ($opts{'-force'} or ! -e $cmpfile) {
155 ## Create the comparison file
27f805f4 156 print "# Creating expected result for \"$testname\"" .
360aca43 157 " pod2plaintext test ...\n";
158 podinc2plaintext($podfile, $cmpfile);
159 }
160 else {
27f805f4 161 print "# File $cmpfile already exists" .
360aca43 162 " (use '-force' to regenerate it).\n";
163 }
164 next;
165 }
166
167 my $failmsg = testpodinc2plaintext
168 -In => $podfile,
169 -Out => $outfile,
170 -Cmp => $cmpfile;
171 if ($failmsg) {
172 ++$failed;
27f805f4 173 print "#\tFAILED. ($failmsg)\n";
360aca43 174 print "not ok ", $failed+$passes, "\n";
175 }
176 else {
177 ++$passes;
178 unlink($outfile);
27f805f4 179 print "#\tPASSED.\n";
360aca43 180 print "ok ", $failed+$passes, "\n";
181 }
182 }
183 return $passes;
184}
185
1861;