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