4103ed6e19b2733638501f98ac890f162e8d579d
[perl.git] / cpan / podlators / t / basic.t
1 #!/usr/bin/perl -w
2 #
3 # basic.t -- Basic tests for podlators.
4 #
5 # Copyright 2001, 2002, 2004, 2006, 2009, 2012
6 #     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     }
16     unshift (@INC, '../blib/lib');
17     $| = 1;
18 }
19
20 use strict;
21
22 use Test::More tests => 15;
23
24 BEGIN {
25     use_ok ('Pod::Man');
26     use_ok ('Pod::Text');
27     use_ok ('Pod::Text::Overstrike');
28     use_ok ('Pod::Text::Termcap');
29 }
30
31 # Find the path to the test source files.  This requires some fiddling when
32 # these tests are run as part of Perl core.
33 sub source_path {
34     my $file = shift;
35     if ($ENV{PERL_CORE}) {
36         require File::Spec;
37         my $updir = File::Spec->updir;
38         my $dir = File::Spec->catdir ($updir, 'lib', 'Pod', 't');
39         return File::Spec->catfile ($dir, $file);
40     } else {
41         return $file;
42     }
43 }
44
45 # Hard-code a few values to try to get reproducible results.
46 $ENV{COLUMNS} = 80;
47 $ENV{TERM} = 'xterm';
48 $ENV{TERMCAP} = 'xterm:co=80:do=^J:md=\E[1m:us=\E[4m:me=\E[m';
49
50 # Map of translators to file extensions to find the formatted output to
51 # compare against.
52 my %translators = ('Pod::Man'              => 'man',
53                    'Pod::Text'             => 'txt',
54                    'Pod::Text::Color'      => 'clr',
55                    'Pod::Text::Overstrike' => 'ovr',
56                    'Pod::Text::Termcap'    => 'cap');
57
58 # Set default options to match those of pod2man and pod2text.
59 our %options = (sentence => 0);
60
61 for my $module (sort keys %translators) {
62   SKIP: {
63         if ($module eq 'Pod::Text::Color') {
64             eval { require Term::ANSIColor };
65             skip 'Term::ANSIColor not found', 3 if $@;
66             require_ok ('Pod::Text::Color');
67         }
68         my $parser = $module->new (%options);
69         isa_ok ($parser, $module, 'Parser object');
70
71         # For Pod::Man, strip out the autogenerated header up to the .TH title
72         # line.  That means that we don't check those things; oh well.  The
73         # header changes with each version change or touch of the input file.
74         open (OUT, "> out$$.tmp") or die "Cannot create out$$.tmp: $!\n";
75         $parser->parse_from_file (source_path ('basic.pod'), \*OUT);
76         close OUT;
77         if ($module eq 'Pod::Man') {
78             open (TMP, "out$$.tmp") or die "Cannot open out$$.tmp: $!\n";
79             open (OUTPUT, "> out$$.$translators{$module}")
80                 or die "Cannot create out$$.$translators{$module}: $!\n";
81             local $_;
82             while (<TMP>) { last if /^\.nh/ }
83             print OUTPUT while <TMP>;
84             close OUTPUT;
85             close TMP;
86             1 while unlink "out$$.tmp";
87         } else {
88             rename ("out$$.tmp", "out$$.$translators{$module}")
89                 or die "Cannot rename out$$.tmp: $!\n";
90         }
91
92         # Slurp the output and expected output and compare them.
93         my ($master, $output);
94         {
95             local $/;
96             open (MASTER, source_path ("basic.$translators{$module}"))
97                 or die "Cannot open basic.$translators{$module}: $!\n";
98             open (OUTPUT, "out$$.$translators{$module}")
99                 or die "Cannot open out$$.$translators{$module}: $!\n";
100             $master = <MASTER>;
101             $output = <OUTPUT>;
102             close MASTER;
103             close OUTPUT;
104         }
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' and $module eq 'Pod::Text::Termcap') {
109             $output =~ tr/\033/\047/;
110         }
111         if (ok ($master eq $output, "$module output is correct")) {
112             1 while unlink "out$$.$translators{$module}";
113         } else {
114             diag ("Non-matching output left in out$$.$translators{$module}\n");
115         }
116     }
117 }