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, 2018-2019, 2022 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# SPDX-License-Identifier: GPL-1.0-or-later OR Artistic-1.0-Perl 22 23use 5.008; 24use strict; 25use warnings; 26 27use lib 't/lib'; 28 29use File::Spec; 30use Test::More tests => 15; 31use Test::Podlators qw(slurp); 32 33# Check that all the modules can be loaded. 34BEGIN { 35 use_ok('Pod::Man'); 36 use_ok('Pod::Text'); 37 use_ok('Pod::Text::Color'); 38 use_ok('Pod::Text::Overstrike'); 39 use_ok('Pod::Text::Termcap'); 40} 41 42# Flush output, since otherwise our diag messages come after other tests. 43local $| = 1; 44 45# Hard-code configuration for Term::Cap to get predictable results. 46#<<< 47local $ENV{COLUMNS} = 80; 48local $ENV{TERM} = 'xterm'; 49local $ENV{TERMPATH} = File::Spec->catfile('t', 'data', 'termcap'); 50local $ENV{TERMCAP} = 'xterm:co=#80:do=^J:md=\\E[1m:us=\\E[4m:me=\\E[m'; 51#>>> 52 53# Find the source of the test file. 54my $input = File::Spec->catfile('t', 'data', 'basic.pod'); 55 56# Map of translators to the file containing the formatted output to compare 57# against. 58#<<< 59my %output = ( 60 'Pod::Man' => File::Spec->catfile('t', 'data', 'basic.man'), 61 'Pod::Text' => File::Spec->catfile('t', 'data', 'basic.txt'), 62 'Pod::Text::Color' => File::Spec->catfile('t', 'data', 'basic.clr'), 63 'Pod::Text::Overstrike' => File::Spec->catfile('t', 'data', 'basic.ovr'), 64 'Pod::Text::Termcap' => File::Spec->catfile('t', 'data', 'basic.cap'), 65); 66#>>> 67 68# Walk through teach of the modules and format the sample file, checking to 69# ensure the results match the pre-generated file. 70for my $module (sort keys %output) { 71 my $parser = $module->new(); 72 isa_ok($parser, $module, 'parser object'); 73 74 # Run the formatting module. Store the output into a Perl variable 75 # instead of a file. 76 my $got; 77 $parser->output_string(\$got); 78 $parser->parse_file($input); 79 80 # If the test module is Pod::Man, strip off the header. This test does 81 # not attempt to compare it, since it contains version numbers that 82 # change. 83 if ($module eq 'Pod::Man') { 84 $got =~ s{ \A .* \n [.]nh \n }{}xms; 85 } 86 87 # Try to convert on EBCDIC boxes so that the test still works. 88 if (ord('A') == 193 && $module eq 'Pod::Text::Termcap') { 89 $got =~ tr{\033}{\047}; 90 } 91 92 # Check the output. If it doesn't match, save the erroneous output in a 93 # file for later inspection. 94 my $expected = slurp($output{$module}); 95 if (!ok($got eq $expected, "$module output is correct")) { 96 my ($suffix) = ($output{$module} =~ m{ [.] ([^.]+) \z }xms); 97 my $tmpdir = File::Spec->catdir('t', 'tmp'); 98 if (!-d $tmpdir) { 99 mkdir($tmpdir, 0777); 100 } 101 my $outfile = File::Spec->catfile('t', 'tmp', "out$$.$suffix"); 102 open(my $output, '>', $outfile) 103 or BAIL_OUT("cannot create $outfile for failed output: $!"); 104 print {$output} $got 105 or BAIL_OUT("cannot write failed output to $outfile: $!"); 106 close($output) 107 or BAIL_OUT("cannot write failed output to $outfile: $!"); 108 diag("Non-matching output left in $outfile"); 109 } 110} 111