1*f2a19305Safresh1#!/usr/bin/perl 2*f2a19305Safresh1# 3*f2a19305Safresh1# Encoding tests for Pod::Man. 4*f2a19305Safresh1# 5*f2a19305Safresh1# This test uses a single test file with UTF-8 characters and escapes and 6*f2a19305Safresh1# processes it with different encoding configurations for Pod::Man, comparing 7*f2a19305Safresh1# it with pre-generated and hand-checked output files. 8*f2a19305Safresh1# 9*f2a19305Safresh1# The primary purpose of these test files is for portability testing on 10*f2a19305Safresh1# different operating systems, but this test ensures that they remain accurate 11*f2a19305Safresh1# for any changes to Pod::Man. It doubles as a test that the preamble is 12*f2a19305Safresh1# emitted correctly. 13*f2a19305Safresh1# 14*f2a19305Safresh1# Copyright 2022 Russ Allbery <rra@cpan.org> 15*f2a19305Safresh1# 16*f2a19305Safresh1# This program is free software; you may redistribute it and/or modify it 17*f2a19305Safresh1# under the same terms as Perl itself. 18*f2a19305Safresh1# 19*f2a19305Safresh1# SPDX-License-Identifier: GPL-1.0-or-later OR Artistic-1.0-Perl 20*f2a19305Safresh1 21*f2a19305Safresh1use 5.008; 22*f2a19305Safresh1use strict; 23*f2a19305Safresh1use warnings; 24*f2a19305Safresh1 25*f2a19305Safresh1use lib 't/lib'; 26*f2a19305Safresh1 27*f2a19305Safresh1use File::Spec; 28*f2a19305Safresh1use Test::More tests => 4; 29*f2a19305Safresh1use Test::Podlators qw(slurp); 30*f2a19305Safresh1 31*f2a19305Safresh1BEGIN { 32*f2a19305Safresh1 use_ok('Pod::Man'); 33*f2a19305Safresh1} 34*f2a19305Safresh1 35*f2a19305Safresh1# Force the timestamp on the input file since it will otherwise depend on the 36*f2a19305Safresh1# checkout. 37*f2a19305Safresh1local $ENV{SOURCE_DATE_EPOCH} = 1664146047; 38*f2a19305Safresh1 39*f2a19305Safresh1# Get the path to the input and output files. 40*f2a19305Safresh1my $input = File::Spec->catfile('t', 'data', 'man', 'encoding.pod'); 41*f2a19305Safresh1#<<< 42*f2a19305Safresh1my %output = ( 43*f2a19305Safresh1 groff => File::Spec->catfile('t', 'data', 'man', 'encoding.groff'), 44*f2a19305Safresh1 roff => File::Spec->catfile('t', 'data', 'man', 'encoding.roff'), 45*f2a19305Safresh1 utf8 => File::Spec->catfile('t', 'data', 'man', 'encoding.utf8'), 46*f2a19305Safresh1); 47*f2a19305Safresh1#>>> 48*f2a19305Safresh1 49*f2a19305Safresh1# For each encoding, load the input, generate the output, and check that the 50*f2a19305Safresh1# output matches. 51*f2a19305Safresh1for my $encoding (sort(keys(%output))) { 52*f2a19305Safresh1 my $parser = Pod::Man->new( 53*f2a19305Safresh1 encoding => $encoding, 54*f2a19305Safresh1 center => 'podlators', 55*f2a19305Safresh1 release => 'testing', 56*f2a19305Safresh1 ); 57*f2a19305Safresh1 my $got; 58*f2a19305Safresh1 $parser->output_string(\$got); 59*f2a19305Safresh1 $parser->parse_file($input); 60*f2a19305Safresh1 61*f2a19305Safresh1 # Strip off the version line. 62*f2a19305Safresh1 $got =~ s{ ^ [^\n]+ Automatically [ ] generated [ ] by [^\n]+ \n }{}xms; 63*f2a19305Safresh1 64*f2a19305Safresh1 # Check the output. If it doesn't match, save the erroneous output in a 65*f2a19305Safresh1 # file for later inspection. 66*f2a19305Safresh1 my $expected = slurp($output{$encoding}); 67*f2a19305Safresh1 if (!ok($got eq $expected, "encoding.pod output with $encoding")) { 68*f2a19305Safresh1 my $tmpdir = File::Spec->catdir('t', 'tmp'); 69*f2a19305Safresh1 if (!-d $tmpdir) { 70*f2a19305Safresh1 mkdir($tmpdir, 0777); 71*f2a19305Safresh1 } 72*f2a19305Safresh1 my $outfile = File::Spec->catfile('t', 'tmp', "encoding$$.$encoding"); 73*f2a19305Safresh1 open(my $output, '>', $outfile) 74*f2a19305Safresh1 or BAIL_OUT("cannot create $outfile for failed output: $!"); 75*f2a19305Safresh1 print {$output} $got 76*f2a19305Safresh1 or BAIL_OUT("cannot write failed output to $outfile: $!"); 77*f2a19305Safresh1 close($output) 78*f2a19305Safresh1 or BAIL_OUT("cannot write failed output to $outfile: $!"); 79*f2a19305Safresh1 diag("Non-matching output left in $outfile"); 80*f2a19305Safresh1 } 81*f2a19305Safresh1} 82