This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Pod::Html - correctly link to =item's on the same page
[perl5.git] / lib / Pod / t / basic.t
1 #!/usr/bin/perl -w
2 # $Id: basic.t,v 1.4 2002/01/28 02:56:19 eagle Exp $
3 #
4 # basic.t -- Basic tests for podlators.
5 #
6 # Copyright 2001 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     require Config;
20     if (($Config::Config{'extensions'} !~ /\bPOSIX\b/) ){
21         print "1..0 # Skip -- Perl configured without POSIX module\n";
22         exit 0;
23     }
24     $| = 1;
25     print "1..11\n";
26 }
27
28 END {
29     print "not ok 1\n" unless $loaded;
30 }
31
32 use Pod::Man;
33 use Pod::Text;
34 use Pod::Text::Color;
35 use Pod::Text::Overstrike;
36 use Pod::Text::Termcap;
37
38 # Find the path to the test source files.  This requires some fiddling when
39 # these tests are run as part of Perl core.
40 sub source_path {
41     my $file = shift;
42     if ($ENV{PERL_CORE}) {
43         require File::Spec;
44         my $updir = File::Spec->updir;
45         my $dir = File::Spec->catdir ($updir, 'lib', 'Pod', 't');
46         return File::Spec->catfile ($dir, $file);
47     } else {
48         return $file;
49     }
50 }
51
52 $loaded = 1;
53 print "ok 1\n";
54
55 # Hard-code a few values to try to get reproducible results.
56 $ENV{COLUMNS} = 80;
57 $ENV{TERM} = 'xterm';
58 $ENV{TERMCAP} = 'xterm:co=80:do=^J:md=\E[1m:us=\E[4m:me=\E[m';
59
60 # Map of translators to file extensions to find the formatted output to
61 # compare against.
62 my %translators = ('Pod::Man'              => 'man',
63                    'Pod::Text'             => 'txt',
64                    'Pod::Text::Color'      => 'clr',
65                    'Pod::Text::Overstrike' => 'ovr',
66                    'Pod::Text::Termcap'    => 'cap');
67
68 # Set default options to match those of pod2man and pod2text.
69 %options = (sentence => 0);
70
71 my $n = 2;
72 for (sort keys %translators) {
73     my $parser = $_->new (%options);
74     print (($parser && ref ($parser) eq $_) ? "ok $n\n" : "not ok $n\n");
75     $n++;
76
77     # For Pod::Man, strip out the autogenerated header up to the .TH title
78     # line.  That means that we don't check those things; oh well.  The header
79     # changes with each version change or touch of the input file.
80     if ($_ eq 'Pod::Man') {
81         $parser->parse_from_file (source_path ('basic.pod'), 'out.tmp');
82         open (TMP, 'out.tmp') or die "Cannot open out.tmp: $!\n";
83         open (OUTPUT, "> out.$translators{$_}")
84             or die "Cannot create out.$translators{$_}: $!\n";
85         local $_;
86         while (<TMP>) { last if /^\.TH/ }
87         print OUTPUT while <TMP>;
88         close OUTPUT;
89         close TMP;
90         unlink 'out.tmp';
91     } else {
92         my $basic = source_path ('basic.pod');
93         $parser->parse_from_file ($basic, "out.$translators{$_}");
94     }
95     {
96         local $/;
97         open (MASTER, source_path ("basic.$translators{$_}"))
98             or die "Cannot open basic.$translators{$_}: $!\n";
99         open (OUTPUT, "out.$translators{$_}")
100             or die "Cannot open out.$translators{$_}: $!\n";
101         my $master = <MASTER>;
102         my $output = <OUTPUT>;
103         close MASTER;
104         close OUTPUT;
105
106         # OS/390 is EBCDIC, which uses a different character for ESC
107         # apparently.  Try to convert so that the test still works.
108         if ($^O eq 'os390' && $_ eq 'Pod::Text::Termcap') {
109             $output =~ tr/\033/\047/;
110         }
111
112         if ($master eq $output) {
113             print "ok $n\n";
114             unlink "out.$translators{$_}";
115         } else {
116             print "not ok $n\n";
117             print "# Non-matching output left in out.$translators{$_}\n";
118         }
119     }
120     $n++;
121 }