1b8851fccSafresh1# Helper functions to test the podlators distribution. 2b8851fccSafresh1# 3b8851fccSafresh1# This module is an internal implementation detail of the podlators test 4b8851fccSafresh1# suite. It provides some supporting functions to make it easier to write 5b8851fccSafresh1# tests. 6b8851fccSafresh1# 7b46d8ef2Safresh1# SPDX-License-Identifier: GPL-1.0-or-later OR Artistic-1.0-Perl 8b8851fccSafresh1 9b8851fccSafresh1package Test::Podlators; 10b8851fccSafresh1 11*e0680481Safresh1use 5.010; 12*e0680481Safresh1use base qw(Exporter); 13b8851fccSafresh1use strict; 14b8851fccSafresh1use warnings; 15b8851fccSafresh1 16b8851fccSafresh1use Encode qw(decode encode); 17b8851fccSafresh1use Exporter; 18b8851fccSafresh1use File::Spec; 19b8851fccSafresh1use Test::More; 20b8851fccSafresh1 21*e0680481Safresh1our $VERSION = '2.01'; 22b8851fccSafresh1 23*e0680481Safresh1# Export the test helper functions. 24*e0680481Safresh1our @EXPORT_OK = qw( 25b8851fccSafresh1 read_snippet read_test_data slurp test_snippet test_snippet_with_io 26b8851fccSafresh1); 27b8851fccSafresh1 28b8851fccSafresh1# The file handle used to capture STDERR while we mess with file descriptors. 29b8851fccSafresh1my $OLD_STDERR; 30b8851fccSafresh1 31b8851fccSafresh1# The file name used to capture standard error output. 32b8851fccSafresh1my $SAVED_STDERR; 33b8851fccSafresh1 34b8851fccSafresh1# Internal function to clean up the standard error output file. Leave the 35b8851fccSafresh1# temporary directory in place, since otherwise we race with other test 36b8851fccSafresh1# scripts trying to create the temporary directory when running tests in 37b8851fccSafresh1# parallel. 38b8851fccSafresh1sub _stderr_cleanup { 39*e0680481Safresh1 if ($SAVED_STDERR && -e $SAVED_STDERR) { 40b8851fccSafresh1 unlink($SAVED_STDERR); 41b8851fccSafresh1 } 42b8851fccSafresh1 return; 43b8851fccSafresh1} 44b8851fccSafresh1 45b8851fccSafresh1# Remove saved standard error on exit, even if we have an abnormal exit. 46b8851fccSafresh1END { 47b8851fccSafresh1 _stderr_cleanup(); 48b8851fccSafresh1} 49b8851fccSafresh1 50b8851fccSafresh1# Internal function to redirect stderr to a file. Stores the name in 51b8851fccSafresh1# $SAVED_STDERR. 52b8851fccSafresh1sub _stderr_save { 53b8851fccSafresh1 my $tmpdir = File::Spec->catdir('t', 'tmp'); 54b8851fccSafresh1 if (!-d $tmpdir) { 55b8851fccSafresh1 mkdir($tmpdir, 0777) or BAIL_OUT("cannot create $tmpdir: $!"); 56b8851fccSafresh1 } 57b8851fccSafresh1 my $path = File::Spec->catfile($tmpdir, "out$$.err"); 58b8851fccSafresh1 open($OLD_STDERR, '>&', STDERR) or BAIL_OUT("cannot dup STDERR: $!"); 59b8851fccSafresh1 open(STDERR, '>', $path) or BAIL_OUT("cannot redirect STDERR: $!"); 60b8851fccSafresh1 $SAVED_STDERR = $path; 61b8851fccSafresh1 return; 62b8851fccSafresh1} 63b8851fccSafresh1 64b8851fccSafresh1# Internal function to restore stderr. 65b8851fccSafresh1# 66b8851fccSafresh1# Returns: The contents of the stderr file. 67b8851fccSafresh1sub _stderr_restore { 68b8851fccSafresh1 return if !$SAVED_STDERR; 69b8851fccSafresh1 close(STDERR) or BAIL_OUT("cannot close STDERR: $!"); 70b8851fccSafresh1 open(STDERR, '>&', $OLD_STDERR) or BAIL_OUT("cannot dup STDERR: $!"); 71b8851fccSafresh1 close($OLD_STDERR) or BAIL_OUT("cannot close redirected STDERR: $!"); 72b8851fccSafresh1 my $stderr = slurp($SAVED_STDERR); 73b8851fccSafresh1 _stderr_cleanup(); 74b8851fccSafresh1 return $stderr; 75b8851fccSafresh1} 76b8851fccSafresh1 77b8851fccSafresh1# Read one test snippet from the provided relative file name and return it. 78*e0680481Safresh1# For the format, see t/data/snippets/README.md. 79b8851fccSafresh1# 80b8851fccSafresh1# $path - Relative path to read test data from 81b8851fccSafresh1# 82b8851fccSafresh1# Returns: Reference to hash of test data with the following keys: 83b8851fccSafresh1# name - Name of the test for status reporting 84b8851fccSafresh1# options - Hash of options 85b8851fccSafresh1# input - The input block of the test data 86b8851fccSafresh1# output - The output block of the test data 87b8851fccSafresh1# errors - Expected errors 88b8851fccSafresh1# exception - Text of exception (with file and line stripped) 89b8851fccSafresh1sub read_snippet { 9056d68f1eSafresh1 my ($path) = @_; 91b8851fccSafresh1 $path = File::Spec->catfile('t', 'data', 'snippets', $path); 92b8851fccSafresh1 my %data; 93b8851fccSafresh1 94b8851fccSafresh1 # Read the sections and store them in the %data hash. 95b8851fccSafresh1 my ($line, $section); 96b8851fccSafresh1 open(my $fh, '<', $path) or BAIL_OUT("cannot open $path: $!"); 97b8851fccSafresh1 while (defined($line = <$fh>)) { 98b8851fccSafresh1 if ($line =~ m{ \A \s* \[ (\S+) \] \s* \z }xms) { 99b8851fccSafresh1 $section = $1; 10056d68f1eSafresh1 $data{$section} = q{}; 101b8851fccSafresh1 } elsif ($section) { 102b8851fccSafresh1 $data{$section} .= $line; 103b8851fccSafresh1 } 104b8851fccSafresh1 } 105b8851fccSafresh1 close($fh) or BAIL_OUT("cannot close $path: $!"); 106b8851fccSafresh1 107b8851fccSafresh1 # Strip trailing blank lines from all sections. 108b8851fccSafresh1 for my $section (keys %data) { 109b8851fccSafresh1 $data{$section} =~ s{ \n\s+ \z }{\n}xms; 110b8851fccSafresh1 } 111b8851fccSafresh1 112b8851fccSafresh1 # Clean up the name section by removing newlines and extra space. 113b8851fccSafresh1 if ($data{name}) { 114b8851fccSafresh1 $data{name} =~ s{ \A \s+ }{}xms; 115b8851fccSafresh1 $data{name} =~ s{ \s+ \z }{}xms; 116b8851fccSafresh1 $data{name} =~ s{ \s+ }{ }xmsg; 117b8851fccSafresh1 } 118b8851fccSafresh1 119b8851fccSafresh1 # Turn the options section into a hash. 120b8851fccSafresh1 if ($data{options}) { 121b8851fccSafresh1 my @lines = split(m{ \n }xms, $data{options}); 122b8851fccSafresh1 delete $data{options}; 123b8851fccSafresh1 for my $optline (@lines) { 124b8851fccSafresh1 next if $optline !~ m{ \S }xms; 125b8851fccSafresh1 my ($option, $value) = split(q{ }, $optline, 2); 126b8851fccSafresh1 if (defined($value)) { 127b8851fccSafresh1 chomp($value); 128b8851fccSafresh1 } else { 129b8851fccSafresh1 $value = q{}; 130b8851fccSafresh1 } 131b8851fccSafresh1 $data{options}{$option} = $value; 132b8851fccSafresh1 } 133b8851fccSafresh1 } 134b8851fccSafresh1 135b8851fccSafresh1 # Return the results. 136b8851fccSafresh1 return \%data; 137b8851fccSafresh1} 138b8851fccSafresh1 139b8851fccSafresh1# Read one set of test data from the provided file handle and return it. 140b8851fccSafresh1# There are several different possible formats, which are specified by the 141b8851fccSafresh1# format option. 142b8851fccSafresh1# 143b8851fccSafresh1# The data read from the file handle will be ignored until a line consisting 144b8851fccSafresh1# solely of "###" is found. Then, two or more blocks separated by "###" are 145b8851fccSafresh1# read, ending with another line of "###". There will always be at least an 146b8851fccSafresh1# input and an output block, and may be more blocks based on the format 147b8851fccSafresh1# configuration. 148b8851fccSafresh1# 149b8851fccSafresh1# $fh - File handle to read the data from 150b8851fccSafresh1# $format_ref - Reference to a hash of options describing the data 151b8851fccSafresh1# errors - Set to true to read expected errors after the output section 152b8851fccSafresh1# options - Set to true to read a hash of options as the first data block 153b8851fccSafresh1# 154b8851fccSafresh1# Returns: Reference to hash of test data with the following keys: 155b8851fccSafresh1# input - The input block of the test data 156b8851fccSafresh1# output - The output block of the test data 157b8851fccSafresh1# errors - Expected errors if errors was set in $format_ref 158b8851fccSafresh1# options - Hash of options if options was set in $format_ref 159b8851fccSafresh1# or returns undef if no more test data is found. 160b8851fccSafresh1sub read_test_data { 161b8851fccSafresh1 my ($fh, $format_ref) = @_; 162b8851fccSafresh1 $format_ref ||= {}; 163b8851fccSafresh1 my %data; 164b8851fccSafresh1 165b8851fccSafresh1 # Find the first block of test data. 166b8851fccSafresh1 my $line; 167b8851fccSafresh1 while (defined($line = <$fh>)) { 168b8851fccSafresh1 last if $line eq "###\n"; 169b8851fccSafresh1 } 170b8851fccSafresh1 if (!defined($line)) { 171b8851fccSafresh1 return; 172b8851fccSafresh1 } 173b8851fccSafresh1 174b8851fccSafresh1 # If the format contains the options key, read the options into a hash. 175b8851fccSafresh1 if ($format_ref->{options}) { 176b8851fccSafresh1 while (defined($line = <$fh>)) { 177b8851fccSafresh1 last if $line eq "###\n"; 178b8851fccSafresh1 my ($option, $value) = split(q{ }, $line, 2); 179b8851fccSafresh1 if (defined($value)) { 180b8851fccSafresh1 chomp($value); 181b8851fccSafresh1 } else { 182b8851fccSafresh1 $value = q{}; 183b8851fccSafresh1 } 184b8851fccSafresh1 $data{options}{$option} = $value; 185b8851fccSafresh1 } 186b8851fccSafresh1 } 187b8851fccSafresh1 188b8851fccSafresh1 # Read the input and output sections. 189b8851fccSafresh1 my @sections = qw(input output); 190b8851fccSafresh1 if ($format_ref->{errors}) { 191b8851fccSafresh1 push(@sections, 'errors'); 192b8851fccSafresh1 } 193b8851fccSafresh1 for my $key (@sections) { 194b8851fccSafresh1 $data{$key} = q{}; 195b8851fccSafresh1 while (defined($line = <$fh>)) { 196b8851fccSafresh1 last if $line eq "###\n"; 197b8851fccSafresh1 $data{$key} .= $line; 198b8851fccSafresh1 } 199b8851fccSafresh1 } 200b8851fccSafresh1 return \%data; 201b8851fccSafresh1} 202b8851fccSafresh1 203b8851fccSafresh1# Slurp output data back from a file handle. It would be nice to use 204b8851fccSafresh1# Perl6::Slurp, but this is a core module, so we have to implement our own 205b8851fccSafresh1# wheels. BAIL_OUT is called on any failure to read the file. 206b8851fccSafresh1# 207b8851fccSafresh1# $file - File to read 208b8851fccSafresh1# $strip - If set to "man", strip out the Pod::Man header 209b8851fccSafresh1# 210b8851fccSafresh1# Returns: Contents of the file, possibly stripped 211b8851fccSafresh1sub slurp { 212b8851fccSafresh1 my ($file, $strip) = @_; 213b8851fccSafresh1 open(my $fh, '<', $file) or BAIL_OUT("cannot open $file: $!"); 214b8851fccSafresh1 215b8851fccSafresh1 # If told to strip the man header, do so. 216b8851fccSafresh1 if (defined($strip) && $strip eq 'man') { 217b8851fccSafresh1 while (defined(my $line = <$fh>)) { 218b8851fccSafresh1 last if $line eq ".nh\n"; 219b8851fccSafresh1 } 220b8851fccSafresh1 } 221b8851fccSafresh1 222b8851fccSafresh1 # Read the rest of the file and return it. 223b8851fccSafresh1 my $data = do { local $/ = undef; <$fh> }; 224b8851fccSafresh1 close($fh) or BAIL_OUT("cannot read from $file: $!"); 225b8851fccSafresh1 return $data; 226b8851fccSafresh1} 227b8851fccSafresh1 228b8851fccSafresh1# Test a formatter on a particular POD snippet. This does all the work of 229b8851fccSafresh1# loading the snippet, creating the formatter, running it, and checking the 230b8851fccSafresh1# results, and reports those results with Test::More. 231b8851fccSafresh1# 232b8851fccSafresh1# $class - Class name of the formatter, as a string 233b8851fccSafresh1# $snippet - Path to the snippet file defining the test 2345759b3d2Safresh1# $options_ref - Hash of options with the following keys: 23556d68f1eSafresh1# encoding - Expect the output to be in this non-standard encoding 236b8851fccSafresh1sub test_snippet { 2375759b3d2Safresh1 my ($class, $snippet, $options_ref) = @_; 23856d68f1eSafresh1 my $data_ref = read_snippet($snippet); 239*e0680481Safresh1 $options_ref //= {}; 24056d68f1eSafresh1 24156d68f1eSafresh1 # Determine the encoding to expect for the output portion of the snippet. 242*e0680481Safresh1 my $encoding = $options_ref->{encoding} // 'UTF-8'; 243b8851fccSafresh1 244b8851fccSafresh1 # Create the formatter object. 245b8851fccSafresh1 my $parser = $class->new(%{ $data_ref->{options} }, name => 'TEST'); 246b8851fccSafresh1 isa_ok($parser, $class, 'Parser object'); 247b8851fccSafresh1 248b8851fccSafresh1 # Save stderr to a temporary file and then run the parser, storing the 249b8851fccSafresh1 # output into a Perl variable. 250b8851fccSafresh1 my $errors = _stderr_save(); 251b8851fccSafresh1 my $got; 252b8851fccSafresh1 $parser->output_string(\$got); 253b8851fccSafresh1 eval { $parser->parse_string_document($data_ref->{input}) }; 254b8851fccSafresh1 my $exception = $@; 255b8851fccSafresh1 my $stderr = _stderr_restore(); 256b8851fccSafresh1 257b8851fccSafresh1 # If we were testing Pod::Man, strip off everything prior to .nh from the 258b8851fccSafresh1 # output so that we aren't testing the generated header. 259b8851fccSafresh1 if ($class eq 'Pod::Man') { 260b8851fccSafresh1 $got =~ s{ \A .* \n [.]nh \n }{}xms; 261b8851fccSafresh1 } 262b8851fccSafresh1 263b46d8ef2Safresh1 # Strip any trailing blank lines (Pod::Text likes to add them). 264b46d8ef2Safresh1 $got =~ s{ \n\s+ \z }{\n}xms; 265b46d8ef2Safresh1 266b8851fccSafresh1 # Check the output, errors, and any exception. 267*e0680481Safresh1 is($got, $data_ref->{output}, "$data_ref->{name}: output"); 26856d68f1eSafresh1 if ($data_ref->{errors} || $stderr) { 26956d68f1eSafresh1 is($stderr, $data_ref->{errors} || q{}, "$data_ref->{name}: errors"); 270b8851fccSafresh1 } 271b8851fccSafresh1 if ($data_ref->{exception} || $exception) { 272b8851fccSafresh1 if ($exception) { 2735759b3d2Safresh1 $exception =~ s{ [ ] at [ ] .* }{\n}xms; 274b8851fccSafresh1 } 275b8851fccSafresh1 is($exception, $data_ref->{exception}, "$data_ref->{name}: exception"); 276b8851fccSafresh1 } 277b8851fccSafresh1 return; 278b8851fccSafresh1} 279b8851fccSafresh1 280*e0680481Safresh1# Helper function to check the preamble of Pod::Man output. 281*e0680481Safresh1# 282*e0680481Safresh1# $name - Name of the test 283*e0680481Safresh1# $fh - File handle with results 284*e0680481Safresh1# $encoding - Expected encoding 285*e0680481Safresh1# 286*e0680481Safresh1# Returns: True if the preamble contains accent definitions 287*e0680481Safresh1sub _check_man_preamble { 288*e0680481Safresh1 my ($name, $fh, $encoding) = @_; 289*e0680481Safresh1 $encoding = lc($encoding); 290*e0680481Safresh1 291*e0680481Safresh1 # Check the encoding line. 292*e0680481Safresh1 my $line = <$fh>; 293*e0680481Safresh1 if ($encoding eq 'ascii') { 294*e0680481Safresh1 unlike( 295*e0680481Safresh1 $line, qr{ mode: [ ] troff }xms, 296*e0680481Safresh1 "$name: no preconv coding line", 297*e0680481Safresh1 ); 298*e0680481Safresh1 } else { 299*e0680481Safresh1 is( 300*e0680481Safresh1 $line, 301*e0680481Safresh1 ".\\\" -*- mode: troff; coding: $encoding -*-\n", 302*e0680481Safresh1 "$name: preconv coding line", 303*e0680481Safresh1 ); 304*e0680481Safresh1 } 305*e0680481Safresh1 306*e0680481Safresh1 # Consume the rest of the preamble and check for accent definitions. 307*e0680481Safresh1 my $saw_accents; 308*e0680481Safresh1 while (defined($line = <$fh>)) { 309*e0680481Safresh1 $line = decode($encoding, $line); 310*e0680481Safresh1 if ($line =~ m{ Accent [ ] mark [ ] definitions }xms) { 311*e0680481Safresh1 $saw_accents = 1; 312*e0680481Safresh1 } 313*e0680481Safresh1 last if $line =~ m{ \A [.]nh }xms; 314*e0680481Safresh1 } 315*e0680481Safresh1 316*e0680481Safresh1 return $saw_accents; 317*e0680481Safresh1} 318*e0680481Safresh1 319b8851fccSafresh1# Test a formatter with I/O streams on a particular POD snippet. This does 320b8851fccSafresh1# all the work of loading the snippet, creating the formatter, running it, and 321b8851fccSafresh1# checking the results, and reports those results with Test::More. It's 322b8851fccSafresh1# similar to test_snippet, but uses input and output temporary files instead 323b8851fccSafresh1# to test encoding layers and also checks the Pod::Man accent output. 324b8851fccSafresh1# 325b8851fccSafresh1# $class - Class name of the formatter, as a string 326b8851fccSafresh1# $snippet - Path to the snippet file defining the test 327b8851fccSafresh1# $options_ref - Hash of options with the following keys: 32856d68f1eSafresh1# encoding - Expect the snippet to be in this non-standard encoding 329*e0680481Safresh1# perlio_utf8 - Set to 1 to set PerlIO UTF-8 encoding on the output file 330*e0680481Safresh1# perlio_iso - Set to 1 to set PerlIO ISO 8859-1 encoding on the output file 331*e0680481Safresh1# output - Expect the output to be in this non-standard encoding 332b8851fccSafresh1sub test_snippet_with_io { 333b8851fccSafresh1 my ($class, $snippet, $options_ref) = @_; 334*e0680481Safresh1 $options_ref //= {}; 335b8851fccSafresh1 my $data_ref = read_snippet($snippet); 336b8851fccSafresh1 33756d68f1eSafresh1 # Determine the encoding to expect for the output portion of the snippet. 338*e0680481Safresh1 my $encoding = $options_ref->{encoding} // 'UTF-8'; 339*e0680481Safresh1 340*e0680481Safresh1 # Determine the encoding to expect for the actual output. 341*e0680481Safresh1 my $outencoding = $options_ref->{output} // 'UTF-8'; 342*e0680481Safresh1 343*e0680481Safresh1 # Additional test output based on whether we're using PerlIO. 344*e0680481Safresh1 my $perlio = q{}; 345*e0680481Safresh1 if ($options_ref->{perlio_utf8} || $options_ref->{perlio_iso}) { 346*e0680481Safresh1 $perlio = ' (PerlIO)'; 34756d68f1eSafresh1 } 34856d68f1eSafresh1 349b8851fccSafresh1 # Create the formatter object. 350b8851fccSafresh1 my $parser = $class->new(%{ $data_ref->{options} }, name => 'TEST'); 351b8851fccSafresh1 isa_ok($parser, $class, 'Parser object'); 352b8851fccSafresh1 353b8851fccSafresh1 # Write the input POD to a temporary file prefaced by the encoding 354b8851fccSafresh1 # directive. 355b8851fccSafresh1 my $tmpdir = File::Spec->catdir('t', 'tmp'); 356b8851fccSafresh1 if (!-d $tmpdir) { 357b8851fccSafresh1 mkdir($tmpdir, 0777) or BAIL_OUT("cannot create $tmpdir: $!"); 358b8851fccSafresh1 } 359b8851fccSafresh1 my $input_file = File::Spec->catfile('t', 'tmp', "tmp$$.pod"); 360b8851fccSafresh1 open(my $input, '>', $input_file) 361b8851fccSafresh1 or BAIL_OUT("cannot create $input_file: $!"); 36256d68f1eSafresh1 print {$input} $data_ref->{input} 363b8851fccSafresh1 or BAIL_OUT("cannot write to $input_file: $!"); 364b8851fccSafresh1 close($input) or BAIL_OUT("cannot flush output to $input_file: $!"); 365b8851fccSafresh1 366b8851fccSafresh1 # Create an output file and parse from the input file to the output file. 367b8851fccSafresh1 my $output_file = File::Spec->catfile('t', 'tmp', "out$$.tmp"); 368b8851fccSafresh1 open(my $output, '>', $output_file) 369b8851fccSafresh1 or BAIL_OUT("cannot create $output_file: $!"); 370b8851fccSafresh1 if ($options_ref->{perlio_utf8}) { 371b8851fccSafresh1 ## no critic (BuiltinFunctions::ProhibitStringyEval) 372b8851fccSafresh1 ## no critic (ValuesAndExpressions::RequireInterpolationOfMetachars) 373b8851fccSafresh1 eval 'binmode($output, ":encoding(utf-8)")'; 374b8851fccSafresh1 ## use critic 375*e0680481Safresh1 } elsif ($options_ref->{perlio_iso}) { 376*e0680481Safresh1 ## no critic (BuiltinFunctions::ProhibitStringyEval) 377*e0680481Safresh1 ## no critic (ValuesAndExpressions::RequireInterpolationOfMetachars) 378*e0680481Safresh1 eval 'binmode($output, ":encoding(iso-8859-1)")'; 379*e0680481Safresh1 ## use critic 380b8851fccSafresh1 } 381b8851fccSafresh1 382b8851fccSafresh1 # Parse the input file into the output file. 383b8851fccSafresh1 $parser->parse_from_file($input_file, $output); 384b8851fccSafresh1 close($output) or BAIL_OUT("cannot flush output to $output_file: $!"); 385b8851fccSafresh1 386*e0680481Safresh1 # Read back in the results. For Pod::Man, also check the coding line, and 387*e0680481Safresh1 # ensure that we didn't output the accent definitions if we wrote UTF-8 388*e0680481Safresh1 # output. 389b8851fccSafresh1 open(my $results, '<', $output_file) 390b8851fccSafresh1 or BAIL_OUT("cannot open $output_file: $!"); 391*e0680481Safresh1 my $saw_accents; 39256d68f1eSafresh1 if ($class eq 'Pod::Man') { 393*e0680481Safresh1 my $name = $data_ref->{name}; 394*e0680481Safresh1 $saw_accents = _check_man_preamble($name, $results, $outencoding); 39556d68f1eSafresh1 } 396b8851fccSafresh1 my $saw = do { local $/ = undef; <$results> }; 397*e0680481Safresh1 $saw = decode($outencoding, $saw); 39856d68f1eSafresh1 $saw =~ s{ \n\s+ \z }{\n}xms; 399b8851fccSafresh1 close($results) or BAIL_OUT("cannot close output file: $!"); 400b8851fccSafresh1 401b8851fccSafresh1 # Clean up. 402b8851fccSafresh1 unlink($input_file, $output_file); 403b8851fccSafresh1 404b8851fccSafresh1 # Check the accent definitions and the output. 40556d68f1eSafresh1 if ($class eq 'Pod::Man') { 406b8851fccSafresh1 is( 407b8851fccSafresh1 $saw_accents, 408*e0680481Safresh1 ($data_ref->{options}{encoding} || q{}) eq 'roff' ? 1 : undef, 409*e0680481Safresh1 "$data_ref->{name}: accent definitions$perlio", 410b8851fccSafresh1 ); 41156d68f1eSafresh1 } 41256d68f1eSafresh1 is( 41356d68f1eSafresh1 $saw, 41456d68f1eSafresh1 decode($encoding, $data_ref->{output}), 415*e0680481Safresh1 "$data_ref->{name}: output$perlio", 41656d68f1eSafresh1 ); 417b8851fccSafresh1 return; 418b8851fccSafresh1} 419b8851fccSafresh1 420b8851fccSafresh11; 421b8851fccSafresh1__END__ 422b8851fccSafresh1 423b8851fccSafresh1=for stopwords 424b8851fccSafresh1Allbery podlators PerlIO UTF-8 formatter FH whitespace 425b8851fccSafresh1 426b8851fccSafresh1=head1 NAME 427b8851fccSafresh1 428b8851fccSafresh1Test::Podlators - Helper functions for podlators tests 429b8851fccSafresh1 430b8851fccSafresh1=head1 SYNOPSIS 431b8851fccSafresh1 432b8851fccSafresh1 use Test::Podlators qw(read_test_data); 433b8851fccSafresh1 434b8851fccSafresh1 # Read the next block of test data, including options. 435b8851fccSafresh1 my $data = read_test_data(\*DATA, { options => 1 }); 436b8851fccSafresh1 437b8851fccSafresh1=head1 DESCRIPTION 438b8851fccSafresh1 439b8851fccSafresh1This module collects various utility functions that are useful for writing 440b8851fccSafresh1test cases for the podlators distribution. It is not intended to be, and 441b8851fccSafresh1probably isn't, useful outside of the test suite for that module. 442b8851fccSafresh1 443b8851fccSafresh1=head1 FUNCTIONS 444b8851fccSafresh1 445b8851fccSafresh1None of these functions are imported by default. The ones used by a script 446b8851fccSafresh1should be explicitly imported. 447b8851fccSafresh1 448b8851fccSafresh1=over 4 449b8851fccSafresh1 45056d68f1eSafresh1=item read_snippet(PATH) 451b8851fccSafresh1 452b8851fccSafresh1Read one test snippet from the provided relative file name and return it. The 453b8851fccSafresh1path should be relative to F<t/data/snippets>. For the format, see 454b8851fccSafresh1F<t/data/snippets/README>. 455b8851fccSafresh1 456b8851fccSafresh1The result will be a hash with the following keys: 457b8851fccSafresh1 458b8851fccSafresh1=over 4 459b8851fccSafresh1 460b8851fccSafresh1=item name 461b8851fccSafresh1 462b8851fccSafresh1The name of the test, for reporting purposes. 463b8851fccSafresh1 464b8851fccSafresh1=item options 465b8851fccSafresh1 466b8851fccSafresh1A hash of any options to values, if any options were specified. 467b8851fccSafresh1 468b8851fccSafresh1=item input 469b8851fccSafresh1 470b8851fccSafresh1Input POD to try formatting. 471b8851fccSafresh1 472b8851fccSafresh1=item output 473b8851fccSafresh1 474b8851fccSafresh1The expected output. 475b8851fccSafresh1 476b8851fccSafresh1=item errors 477b8851fccSafresh1 478b8851fccSafresh1Expected errors from the POD formatter. 479b8851fccSafresh1 480b8851fccSafresh1=item exception 481b8851fccSafresh1 482b8851fccSafresh1An expected exception from the POD formatter, with the file and line 483b8851fccSafresh1information stripped from the end of the exception. 484b8851fccSafresh1 485b8851fccSafresh1=back 486b8851fccSafresh1 487b8851fccSafresh1=item read_test_data(FH, FORMAT) 488b8851fccSafresh1 489b8851fccSafresh1Reads a block of test data from FH, looking for test information according to 490b8851fccSafresh1the description provided in FORMAT. All data prior to the first line 491b8851fccSafresh1consisting of only C<###> will be ignored. Then, the test data must consist 492b8851fccSafresh1of two or more blocks separated by C<###> and ending in a final C<###> line. 493b8851fccSafresh1 494b8851fccSafresh1FORMAT is optional, in which case the block of test data should be just input 495b8851fccSafresh1text and output text. If provided, it should be a reference to a hash with 496b8851fccSafresh1one or more of the following keys: 497b8851fccSafresh1 498b8851fccSafresh1=over 4 499b8851fccSafresh1 500b8851fccSafresh1=item options 501b8851fccSafresh1 502b8851fccSafresh1If set, the first block of data in the test description is a set of options in 503b8851fccSafresh1the form of a key, whitespace, and a value, one per line. The value may be 504b8851fccSafresh1missing, in which case the value associated with the key is the empty string. 505b8851fccSafresh1 506b8851fccSafresh1=back 507b8851fccSafresh1 508b8851fccSafresh1The return value is a hash with at least some of the following keys: 509b8851fccSafresh1 510b8851fccSafresh1=over 4 511b8851fccSafresh1 512b8851fccSafresh1=item input 513b8851fccSafresh1 514b8851fccSafresh1The input data for the test. This is always present. 515b8851fccSafresh1 516b8851fccSafresh1=item options 517b8851fccSafresh1 518b8851fccSafresh1If C<options> is set in the FORMAT argument, this is the hash of keys and 519b8851fccSafresh1values in the options section of the test data. 520b8851fccSafresh1 521b8851fccSafresh1=item output 522b8851fccSafresh1 523b8851fccSafresh1The output data for the test. This is always present. 524b8851fccSafresh1 525b8851fccSafresh1=back 526b8851fccSafresh1 527b8851fccSafresh1=item slurp(FILE[, STRIP]) 528b8851fccSafresh1 529b8851fccSafresh1Read the contents of FILE and return it as a string. If STRIP is set to 530b8851fccSafresh1C<man>, strip off any Pod::Man header from the file before returning it. 531b8851fccSafresh1 5325759b3d2Safresh1=item test_snippet(CLASS, SNIPPET[, OPTIONS]) 533b8851fccSafresh1 534b8851fccSafresh1Test a formatter on a particular POD snippet. This does all the work of 535b8851fccSafresh1loading the snippet, creating the formatter by instantiating CLASS, running 536b8851fccSafresh1it, and checking the results. Results are reported with Test::More. 537b8851fccSafresh1 5385759b3d2Safresh1OPTIONS, if present, is a reference to a hash of options. Currently, only 5395759b3d2Safresh1one key is supported: C<encoding>, which, if set, specifies the encoding of 54056d68f1eSafresh1the output portion of the snippet. 5415759b3d2Safresh1 542b8851fccSafresh1=item test_snippet_with_io(CLASS, SNIPPET[, OPTIONS]) 543b8851fccSafresh1 544b8851fccSafresh1The same as test_snippet(), except, rather than parsing the input into a 545b8851fccSafresh1string buffer, this function uses real, temporary input and output files. 546*e0680481Safresh1This can be used to test I/O layer handling and proper encoding. It also 547*e0680481Safresh1does additional tests for the preamble to the *roff output. 548b8851fccSafresh1 549*e0680481Safresh1OPTIONS, if present, is a reference to a hash of options chosen from the 550*e0680481Safresh1following: 551*e0680481Safresh1 552*e0680481Safresh1=over 4 553*e0680481Safresh1 554*e0680481Safresh1=item encoding 555*e0680481Safresh1 556*e0680481Safresh1The encoding to expect from the snippet file. Default if not specified is 557*e0680481Safresh1UTF-8. 558*e0680481Safresh1 559*e0680481Safresh1=item output 560*e0680481Safresh1 561*e0680481Safresh1The encoding to expect from the output. Default if not specified is UTF-8. 562*e0680481Safresh1 563*e0680481Safresh1=item perlio_iso 564*e0680481Safresh1 565*e0680481Safresh1If set to true, set a PerlIO ISO-8859-1 encoding layer on the output file 566*e0680481Safresh1before writing to it. 567*e0680481Safresh1 568*e0680481Safresh1=item perlio_utf8 569*e0680481Safresh1 570*e0680481Safresh1If set to true, set a PerlIO UTF-8 encoding layer on the output file before 571*e0680481Safresh1writing to it. 572*e0680481Safresh1 573*e0680481Safresh1=back 574b8851fccSafresh1 575b8851fccSafresh1=back 576b8851fccSafresh1 577b8851fccSafresh1=head1 AUTHOR 578b8851fccSafresh1 579b8851fccSafresh1Russ Allbery <rra@cpan.org> 580b8851fccSafresh1 581b8851fccSafresh1=head1 COPYRIGHT AND LICENSE 582b8851fccSafresh1 583*e0680481Safresh1Copyright 2015-2016, 2018-2020, 2022 Russ Allbery <rra@cpan.org> 584b8851fccSafresh1 585b8851fccSafresh1This program is free software; you may redistribute it and/or modify it 586b8851fccSafresh1under the same terms as Perl itself. 587b8851fccSafresh1 588b8851fccSafresh1=cut 589b46d8ef2Safresh1 590b46d8ef2Safresh1# Local Variables: 591b46d8ef2Safresh1# copyright-at-end-flag: t 592b46d8ef2Safresh1# End: 593