Update podlators to version 4.03
[perl.git] / cpan / podlators / t / general / basic.t
1 #!/usr/bin/perl
2 #
3 # Basic tests for podlators.
4 #
5 # This test case uses a single sample file and runs it through all available
6 # formatting modules, comparing the results to known-good output that's
7 # included with the package.  This provides a general sanity check that the
8 # modules are working properly.
9 #
10 # New regression tests and special cases should probably not be added to the
11 # sample input file, since updating all the output files is painful.  Instead,
12 # the machinery to run small POD snippets through the specific formatter being
13 # tested should probably be used instead.
14 #
15 # Copyright 2001, 2002, 2004, 2006, 2009, 2012, 2014, 2015
16 #     Russ Allbery <rra@cpan.org>
17 #
18 # This program is free software; you may redistribute it and/or modify it
19 # under the same terms as Perl itself.
20
21 use 5.006;
22 use strict;
23 use warnings;
24
25 use lib 't/lib';
26
27 use File::Spec;
28 use Test::More tests => 15;
29 use Test::Podlators qw(slurp);
30
31 # Check that all the modules can be loaded.
32 BEGIN {
33     use_ok('Pod::Man');
34     use_ok('Pod::Text');
35     use_ok('Pod::Text::Color');
36     use_ok('Pod::Text::Overstrike');
37     use_ok('Pod::Text::Termcap');
38 }
39
40 # Flush output, since otherwise our diag messages come after other tests.
41 local $| = 1;
42
43 # Hard-code configuration for Term::Cap to get predictable results.
44 local $ENV{COLUMNS}  = 80;
45 local $ENV{TERM}     = 'xterm';
46 local $ENV{TERMPATH} = File::Spec->catfile('t', 'data', 'termcap');
47 local $ENV{TERMCAP}  = 'xterm:co=#80:do=^J:md=\\E[1m:us=\\E[4m:me=\\E[m';
48
49 # Find the source of the test file.
50 my $INPUT = File::Spec->catfile('t', 'data', 'basic.pod');
51
52 # Map of translators to the file containing the formatted output to compare
53 # against.
54 my %OUTPUT = (
55     'Pod::Man'              => File::Spec->catfile('t', 'data', 'basic.man'),
56     'Pod::Text'             => File::Spec->catfile('t', 'data', 'basic.txt'),
57     'Pod::Text::Color'      => File::Spec->catfile('t', 'data', 'basic.clr'),
58     'Pod::Text::Overstrike' => File::Spec->catfile('t', 'data', 'basic.ovr'),
59     'Pod::Text::Termcap'    => File::Spec->catfile('t', 'data', 'basic.cap'),
60 );
61
62 # Options to pass to all formatting modules.  Match the pod2text default.
63 my @OPTIONS = (sentence => 0);
64
65 # Walk through teach of the modules and format the sample file, checking to
66 # ensure the results match the pre-generated file.
67 for my $module (sort keys %OUTPUT) {
68     my $parser = $module->new(@OPTIONS);
69     isa_ok($parser, $module, 'parser object');
70
71     # Run the formatting module.  Store the output into a Perl variable
72     # instead of a file.
73     my $got;
74     $parser->output_string(\$got);
75     $parser->parse_file($INPUT);
76
77     # If the test module is Pod::Man, strip off the header.  This test does
78     # not attempt to compare it, since it contains version numbers that
79     # change.
80     if ($module eq 'Pod::Man') {
81         $got =~ s{ \A .* \n [.]nh \n }{}xms;
82     }
83
84     # OS/390 is EBCDIC, which apparently uses a different character for ESC.
85     # Try to convert so that the test still works.
86     if ($^O eq 'os390' && $module eq 'Pod::Text::Termcap') {
87         $got =~ tr{\033}{\047};
88     }
89
90     # Check the output.  If it doesn't match, save the erroneous output in a
91     # file for later inspection.
92     my $expected = slurp($OUTPUT{$module});
93     if (!ok($got eq $expected, "$module output is correct")) {
94         my ($suffix) = ($OUTPUT{$module} =~ m{ [.] ([^.]+) \z }xms);
95         my $tmpdir = File::Spec->catdir('t', 'tmp');
96         if (!-d $tmpdir) {
97             mkdir($tmpdir, 0777);
98         }
99         my $outfile = File::Spec->catfile('t', 'tmp', "out$$.$suffix");
100         open(my $output, '>', $outfile)
101           or BAIL_OUT("cannot create $outfile for failed output: $!");
102         print {$output} $got
103           or BAIL_OUT("cannot write failed output to $outfile: $!");
104         close($output)
105           or BAIL_OUT("cannot write failed output to $outfile: $!");
106         diag("Non-matching output left in $outfile");
107     }
108 }