Upgrade to podlators-2.0.3
[perl.git] / lib / Pod / t / basic.t
1 #!/usr/bin/perl -w
2 # $Id: basic.t,v 1.10 2006-01-28 22:31:50 eagle Exp $
3 #
4 # basic.t -- Basic tests for podlators.
5 #
6 # Copyright 2001, 2002, 2004, 2006 by Russ Allbery <rra@stanford.edu>
7 #
8 # This program is free software; you may redistribute it and/or modify it
9 # under the same terms as Perl itself.
10
11 BEGIN {
12     chdir 't' if -d 't';
13     if ($ENV{PERL_CORE}) {
14         @INC = '../lib';
15     } else {
16         unshift (@INC, '../blib/lib');
17     }
18     unshift (@INC, '../blib/lib');
19     $| = 1;
20     print "1..11\n";
21 }
22
23 END {
24     print "not ok 1\n" unless $loaded;
25 }
26
27 use Pod::Man;
28 use Pod::Text;
29 use Pod::Text::Overstrike;
30 use Pod::Text::Termcap;
31
32 # Find the path to the test source files.  This requires some fiddling when
33 # these tests are run as part of Perl core.
34 sub source_path {
35     my $file = shift;
36     if ($ENV{PERL_CORE}) {
37         require File::Spec;
38         my $updir = File::Spec->updir;
39         my $dir = File::Spec->catdir ($updir, 'lib', 'Pod', 't');
40         return File::Spec->catfile ($dir, $file);
41     } else {
42         return $file;
43     }
44 }
45
46 $loaded = 1;
47 print "ok 1\n";
48
49 # Hard-code a few values to try to get reproducible results.
50 $ENV{COLUMNS} = 80;
51 $ENV{TERM} = 'xterm';
52 $ENV{TERMCAP} = 'xterm:co=80:do=^J:md=\E[1m:us=\E[4m:me=\E[m';
53
54 # Map of translators to file extensions to find the formatted output to
55 # compare against.
56 my %translators = ('Pod::Man'              => 'man',
57                    'Pod::Text'             => 'txt',
58                    'Pod::Text::Color'      => 'clr',
59                    'Pod::Text::Overstrike' => 'ovr',
60                    'Pod::Text::Termcap'    => 'cap');
61
62 # Set default options to match those of pod2man and pod2text.
63 %options = (sentence => 0);
64
65 my $n = 2;
66 for (sort keys %translators) {
67     if ($_ eq 'Pod::Text::Color') {
68         eval { require Term::ANSIColor };
69         if ($@) {
70             print "ok $n # skip\n";
71             $n++;
72             print "ok $n # skip\n";
73             $n++;
74             next;
75         }
76         require Pod::Text::Color;
77     }
78     my $parser = $_->new (%options);
79     print (($parser && ref ($parser) eq $_) ? "ok $n\n" : "not ok $n\n");
80     $n++;
81
82     # For Pod::Man, strip out the autogenerated header up to the .TH title
83     # line.  That means that we don't check those things; oh well.  The header
84     # changes with each version change or touch of the input file.
85     open (OUT, '> out.tmp') or die "Cannot create out.tmp: $!\n";
86     $parser->parse_from_file (source_path ('basic.pod'), \*OUT);
87     close OUT;
88     if ($_ eq 'Pod::Man') {
89         open (TMP, 'out.tmp') or die "Cannot open out.tmp: $!\n";
90         open (OUTPUT, "> out.$translators{$_}")
91             or die "Cannot create out.$translators{$_}: $!\n";
92         local $_;
93         while (<TMP>) { last if /^\.TH/ }
94         print OUTPUT while <TMP>;
95         close OUTPUT;
96         close TMP;
97         unlink 'out.tmp';
98     } else {
99         rename ('out.tmp', "out.$translators{$_}")
100             or die "Cannot rename out.tmp: $!\n";
101     }
102     {
103         local $/;
104         open (MASTER, source_path ("basic.$translators{$_}"))
105             or die "Cannot open basic.$translators{$_}: $!\n";
106         open (OUTPUT, "out.$translators{$_}")
107             or die "Cannot open out.$translators{$_}: $!\n";
108         my $master = <MASTER>;
109         my $output = <OUTPUT>;
110         close MASTER;
111         close OUTPUT;
112
113         # OS/390 is EBCDIC, which uses a different character for ESC
114         # apparently.  Try to convert so that the test still works.
115         if ($^O eq 'os390' && $_ eq 'Pod::Text::Termcap') {
116             $output =~ tr/\033/\047/;
117         }
118
119         if ($master eq $output) {
120             print "ok $n\n";
121             unlink "out.$translators{$_}";
122         } else {
123             print "not ok $n\n";
124             print "# Non-matching output left in out.$translators{$_}\n";
125         }
126     }
127     $n++;
128 }