| #! /usr/bin/env perl |
| # t/* test support for the Perl modules. |
| # |
| # Copyright 2010-2026 Free Software Foundation, Inc. |
| # |
| # This program is free software; you can redistribute it and/or modify |
| # it under the terms of the GNU General Public License as published by |
| # the Free Software Foundation; either version 3 of the License, |
| # or (at your option) any later version. |
| # |
| # This program is distributed in the hope that it will be useful, |
| # but WITHOUT ANY WARRANTY; without even the implied warranty of |
| # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| # GNU General Public License for more details. |
| # |
| # You should have received a copy of the GNU General Public License |
| # along with this program. If not, see <https://www.gnu.org/licenses/>. |
| # |
| # Original author: Patrice Dumas <pertusus@free.fr> |
| |
| use strict; |
| |
| #no autovivification qw(fetch delete exists store strict); |
| |
| use 5.006; |
| |
| BEGIN { |
| |
| require Texinfo::ModulePath; |
| Texinfo::ModulePath::init(undef, undef, undef, 'updirs' => 2); |
| |
| use Texinfo::XSLoader; |
| |
| # NOTE in general file names and directory names are not encoded, |
| # there will be problems if there are non ascii characters in those |
| # strings. |
| # For consistent test results, use the C locale. |
| # Note that this could prevent displaying non ascii characters |
| # in error messages. |
| $ENV{LC_ALL} = 'C'; |
| $ENV{LANGUAGE} = 'en'; |
| |
| } # end BEGIN |
| |
| use Test::More; |
| |
| #use Carp q(cluck); |
| # to determine the locale encoding to output the Texinfo to Texinfo |
| # result when regenerating |
| use I18N::Langinfo qw(langinfo CODESET); |
| use Encode (); |
| #use Data::Dumper (); |
| #use Data::Compare (); |
| #use Test::Deep (); |
| use Storable qw(dclone); # standard in 5.007003 |
| use Getopt::Long qw(GetOptions); |
| use Locale::Messages (); |
| #use Test::Differences; |
| #unified_diff; |
| |
| #eval { |
| # require Test::Differences; Test::Differences->import(('eq_or_diff_text', 'unified_diff')); unified_diff(); |
| #}; |
| |
| #my $test_differences_loading_error = $@; |
| |
| use Texinfo::Tests qw(compare_dirs_files is_diff unlink_dir_files); |
| |
| use Texinfo::Commands; |
| use Texinfo::Options; |
| use Texinfo::Common; |
| use Texinfo::Convert::Texinfo; |
| use Texinfo::Config; |
| use Texinfo::Parser; |
| use Texinfo::Convert::Text; |
| use Texinfo::Document; |
| use Texinfo::Convert::PlainTexinfo; |
| use Texinfo::ManipulateTree; |
| use Texinfo::Structuring; |
| use Texinfo::OutputUnits; |
| use Texinfo::Indices; |
| use Texinfo::Translations; |
| use Texinfo::Convert::Plaintext; |
| use Texinfo::Convert::Info; |
| use Texinfo::Convert::LaTeX; |
| use Texinfo::Convert::HTML; |
| use Texinfo::Example::TexinfoXML; |
| use Texinfo::Convert::DocBook; |
| #use Texinfo::Example::ReadDocBook; |
| |
| # the tests reference perl results file is loaded through a require |
| # of a file containing code setting those variables. |
| use vars qw(%result_texis %result_texts %result_tree_text %result_errors |
| %result_indices %result_floats %result_nodes_list %result_sections_list |
| %result_sectioning_root %result_headings_list |
| %result_converted %result_converted_errors %result_indices_sort_strings); |
| |
| Locale::Messages->select_package('gettext_pp'); |
| |
| # Force Perl STDERR to be in UTF-8, to have the same encoding as C |
| # direct output on stderr. |
| binmode(STDERR, ":encoding(UTF-8)"); |
| |
| use File::Spec; |
| my $updir = File::Spec->updir(); |
| |
| # Find input files in srcdir |
| my $t2a_srcdir = $Texinfo::ModulePath::t2a_srcdir; |
| my $srcdir = $ENV{'srcdir'}; |
| |
| if (!defined($srcdir) and defined($t2a_srcdir)) { |
| $srcdir = join('/', ($t2a_srcdir, 'perl')); |
| } |
| $srcdir = '.' if (!defined($srcdir) or $srcdir eq ''); |
| |
| # Find locales in builddir |
| my $t2a_builddir = $Texinfo::ModulePath::t2a_builddir; |
| |
| if (!defined($t2a_builddir)) { |
| $t2a_builddir = $updir; |
| } |
| |
| # NOTE if the LocaleData directory is not found, the test could still succeed |
| # if the translations for the strings textdomain are found elsewhere in the |
| # system. If the translations found elsewhere are too old, some tests could |
| # still fail. |
| my $locales_dir; |
| foreach my $dir ("LocaleData", join('/', ($t2a_builddir, 'LocaleData'))) { |
| if (-d $dir) { |
| $locales_dir = $dir; |
| } |
| } |
| |
| if (! defined($locales_dir)) { |
| warn "No locales directory found, some tests could fail\n"; |
| } |
| |
| Texinfo::Translations::setup_output_strings($locales_dir); |
| |
| Locale::Messages::bindtextdomain('texinfo', $locales_dir); |
| |
| my $default_test_level = 1; |
| if (defined($Texinfo::ModulePath::default_test_level) |
| and ($Texinfo::ModulePath::default_test_level == 1 |
| or $Texinfo::ModulePath::default_test_level == 2)) { |
| $default_test_level = $Texinfo::ModulePath::default_test_level; |
| } |
| |
| my $XS_structuring = Texinfo::XSLoader::XS_structuring_enabled(); |
| my $XS_conversion = Texinfo::XSLoader::XS_convert_enabled(); |
| |
| my $generated_texis_dir = 't_texis'; |
| |
| my $input_files_dir = $srcdir."/t/input_files/"; |
| |
| my $output_files_dir = 't/output_files/'; |
| foreach my $dir ('t', 't/results', $output_files_dir) { |
| my $error; |
| # to avoid a race conditon, first create the dir then test that it |
| # exists |
| mkdir $dir or $error = $!; |
| if (! -d $dir) { |
| die "mkdir $dir: $error\n"; |
| } |
| } |
| |
| my $locale_encoding = langinfo(CODESET); |
| $locale_encoding = undef if ($locale_encoding eq ''); |
| |
| # TODO use same code as in texi2any for MSWin32 |
| |
| # to encode is() diagnostic messages. From Test::More documentation |
| if (defined($locale_encoding)) { |
| my $builder = Test::More->builder; |
| binmode $builder->output, ":encoding($locale_encoding)"; |
| binmode $builder->failure_output, ":encoding($locale_encoding)"; |
| binmode $builder->todo_output, ":encoding($locale_encoding)"; |
| } |
| |
| # used to check that there are no file overwritten with -o |
| my %output_files; |
| |
| ok(1); |
| |
| my %formats = ( |
| 'plaintext' => \&convert_to_plaintext, |
| 'file_plaintext' => \&convert_to_plaintext, |
| 'info' => \&convert_to_info, |
| 'file_info' => \&convert_to_info, |
| 'html' => \&convert_to_html, |
| # Can also be used for epub, the only difference is the name of the |
| # output directory. |
| 'file_html' => \&convert_to_html, |
| 'html_text' => \&convert_to_html, |
| # NOTE setting file_epub format does not automatically loads epub3.pm, |
| # since init files are handled before parsing. The init file should |
| # also be added to init_files. |
| 'file_epub' => \&convert_to_html, |
| 'xml' => \&convert_to_xml, |
| 'file_xml' => \&convert_to_xml, |
| 'docbook' => \&convert_to_docbook, |
| 'file_docbook' => \&convert_to_docbook, |
| # call output, not convert |
| 'docbook_doc' => \&convert_to_docbook, |
| 'latex' => \&convert_to_latex, |
| 'latex_text' => \&convert_to_latex, |
| 'file_latex' => \&convert_to_latex, |
| ); |
| |
| my %extensions = ( |
| 'plaintext' => 'txt', |
| 'html_text' => 'html', |
| 'xml' => 'xml', |
| 'docbook' => 'dbk', |
| 'docbook_doc' => 'dbk', |
| 'latex' => 'tex', |
| 'latex_text' => 'tex', |
| ); |
| |
| my %outfile_preamble = ( |
| 'docbook' => ['<?xml version="1.0"?> |
| <!DOCTYPE book PUBLIC "-//OASIS//DTD DocBook XML V4.5//EN" "http://www.oasis-open.org/docbook/xml/4.5/docbookx.dtd" [ |
| <!ENTITY tex "TeX"> |
| <!ENTITY latex "LaTeX"> |
| ]> |
| '. "<book>\n", "</book>\n"], |
| 'xml' => ['<?xml version="1.0"?> |
| '."<!DOCTYPE texinfo PUBLIC \"-//GNU//DTD TexinfoML V7.3//EN\" \"http://www.gnu.org/software/texinfo/dtd/7.3/texinfo.dtd\"> |
| ".'<texinfo> |
| ', "</texinfo>\n"], |
| # done dynamically for CSS |
| 'html_text' => \&output_preamble_postamble_html, |
| 'latex_text' => \&output_preamble_postamble_latex, |
| ); |
| |
| my $arg_generate; |
| my $arg_debug; |
| my $arg_complete; |
| my $arg_output; |
| my $nr_comparisons; |
| $nr_comparisons = 11; |
| |
| Getopt::Long::Configure("gnu_getopt"); |
| # complete: output a complete texinfo file based on the test. Does not |
| # run the tests at all. |
| # generate: run the tests and reset reference results instead of comparing |
| # with reference results. |
| # output: run the test, compare with references, and output the test results |
| # (even if not the same as references) in output files per output |
| # format. |
| GetOptions('g|generate' => \$arg_generate, 'd|debug=i' => \$arg_debug, |
| 'c|complete' => \$arg_complete, 'o|output' => \$arg_output); |
| |
| sub protect_perl_string($) |
| { |
| my $string = shift; |
| #if (!defined($string)) { |
| # cluck(); |
| #} |
| $string =~ s/\\/\\\\/g; |
| $string =~ s/'/\\'/g; |
| # \r can be mangled upon reading if at end of line |
| $string =~ s/\r/'."\\r".'/g; |
| return $string; |
| } |
| |
| sub new_test($;$$$) |
| { |
| my $name = shift; |
| my $generate = shift; |
| my $debug = shift; |
| my $test_formats = shift; |
| my $test = {'name' => $name, 'generate' => $generate, |
| 'DEBUG' => $debug, 'test_formats' => $test_formats}; |
| |
| if ($generate) { |
| mkdir $srcdir."/t/results/$name" |
| if (! -d $srcdir."/t/results/$name"); |
| } |
| bless $test; |
| return $test; |
| } |
| |
| sub set_converter_option_defaults($$;$) |
| { |
| my $converter_options = shift; |
| my $format = shift; |
| my $debug = shift; |
| |
| $converter_options = {} if (!defined($converter_options)); |
| |
| if (!defined($converter_options->{'EXPANDED_FORMATS'})) { |
| $converter_options->{'EXPANDED_FORMATS'} = [$format]; |
| } |
| |
| # NOTE not the same as in texi2any if the format and the output |
| # format name do not match, the case of xml, which output format |
| # name is texinfoxml. No consequence as it is only used for output |
| # directory name, which is overriden in tests anyway. |
| $converter_options->{'TEXINFO_OUTPUT_FORMAT'} = $format; |
| |
| if (!defined($converter_options->{'DEBUG'})) { |
| $converter_options->{'DEBUG'} = $debug; |
| } |
| if (!defined($converter_options->{'CHECK_HTMLXREF'})) { |
| # avoid bloating test results with warnings |
| $converter_options->{'CHECK_HTMLXREF'} = 0; |
| } |
| |
| return $converter_options; |
| } |
| |
| # NOTE this function is unlikely to be called, as files are closed in |
| # converters except for STDOUT, but in the tests the output is not to STDOUT. |
| sub close_files($) |
| { |
| my $converter = shift; |
| my $converter_unclosed_files |
| = Texinfo::Convert::Utils::output_files_unclosed_files( |
| $converter->output_files_information()); |
| if ($converter_unclosed_files) { |
| my $close_error_nr = 0; |
| foreach my $unclosed_file (keys(%$converter_unclosed_files)) { |
| my $fh = $converter_unclosed_files->{$unclosed_file}; |
| # undefined file handle means that the path comes from XS (normally |
| # through build_output_files_unclosed_files) but is not associated |
| # with a file handle yet, as a file handle can't be directly associated |
| # with a stream in C code, but the stream can be returned through |
| # an XS interface, here |
| # Texinfo::Convert::ConvertConverterXS::get_unclosed_stream. |
| if (!defined($fh)) { |
| $fh = $converter->XS_get_unclosed_stream($unclosed_file); |
| if (!defined($fh)) { |
| next; |
| } |
| } |
| if (!close($fh)) { |
| warn(sprintf("test_utils.pl: error on closing %s: %s\n", |
| $unclosed_file, $!)); |
| $close_error_nr++; |
| } |
| } |
| die if ($close_error_nr > 0); |
| } |
| |
| Texinfo::Convert::Utils::output_files_reset( |
| $converter->output_files_information()); |
| } |
| |
| sub _convert($$$) { |
| my ($converter, $document, $do_convert) = @_; |
| |
| my $result; |
| |
| # Get the errors in converter before doing any conversion |
| my $converter_init_errors = $converter->get_converter_errors(); |
| |
| if ($do_convert) { |
| $result = $converter->convert($document); |
| $converter->converter_remove_output_units(); |
| ## forget the error messages of the first conversion |
| #$converter->get_converter_errors(); |
| #$result = $converter->convert($document); |
| #$converter->converter_remove_output_units(); |
| } else { |
| $result = $converter->output($document); |
| close_files($converter); |
| $converter->converter_remove_output_units(); |
| ## forget the error messages of the first conversion |
| #$converter->get_converter_errors(); |
| #$result = $converter->output($document); |
| #close_files($converter); |
| $result = undef if (defined($result) and ($result eq '')); |
| } |
| |
| return $result, $converter_init_errors; |
| } |
| |
| sub convert_to_plaintext($$$$$) |
| { |
| my $self = shift; |
| my $test_name = shift; |
| my $format = shift; |
| my $document = shift; |
| my $converter_options = shift; |
| |
| $converter_options |
| = set_converter_option_defaults($converter_options, 'plaintext', |
| $self->{'DEBUG'}); |
| |
| if (!defined($converter_options->{'OUTFILE'}) |
| and defined($converter_options->{'SUBDIR'})) { |
| # need to set OUTFILE in any case otherwise the default of - |
| # will be used |
| if ($converter_options->{'SPLIT'}) { |
| $converter_options->{'OUTFILE'} = undef; |
| } else { |
| $converter_options->{'OUTFILE'} |
| = $converter_options->{'SUBDIR'}.$test_name.".txt"; |
| } |
| } |
| |
| my $converter = Texinfo::Convert::Plaintext->converter($converter_options); |
| |
| my ($result, $converter_init_errors) = _convert($converter, $document, |
| (defined($converter_options->{'OUTFILE'}) |
| and $converter_options->{'OUTFILE'} eq '')); |
| return ($result, $converter, $converter_init_errors); |
| } |
| |
| sub convert_to_info($$$$$) |
| { |
| my $self = shift; |
| my $test_name = shift; |
| my $format = shift; |
| my $document = shift; |
| my $converter_options = shift; |
| |
| $converter_options |
| = set_converter_option_defaults($converter_options, 'info', |
| $self->{'DEBUG'}); |
| |
| my $converter = Texinfo::Convert::Info->converter($converter_options); |
| |
| my ($result, $converter_init_errors) = _convert($converter, $document, 0); |
| |
| die if (!defined($converter_options->{'SUBDIR'}) and !defined($result)); |
| |
| return ($result, $converter, $converter_init_errors); |
| } |
| |
| sub convert_to_html($$$$$) |
| { |
| my $self = shift; |
| my $test_name = shift; |
| my $format = shift; |
| my $document = shift; |
| my $converter_options = shift; |
| |
| my $add_epub_expanded_format; |
| if ($format eq 'epub' |
| and (!defined($converter_options) |
| or !exists($converter_options->{'EXPANDED_FORMATS'}))) { |
| $add_epub_expanded_format = 1; |
| } |
| |
| $converter_options |
| = set_converter_option_defaults($converter_options, 'html', |
| $self->{'DEBUG'}); |
| |
| push @{$converter_options->{'EXPANDED_FORMATS'}}, 'epub' |
| if ($add_epub_expanded_format); |
| |
| $converter_options->{'SPLIT'} = '' |
| if ($format eq 'html_text' |
| and !defined($converter_options->{'SPLIT'})); |
| |
| my $converter = Texinfo::Convert::HTML->converter($converter_options); |
| |
| my ($result, $converter_init_errors) |
| = _convert($converter, $document, $format eq 'html_text'); |
| |
| die if (!defined($converter_options->{'SUBDIR'}) and !defined($result)); |
| |
| return ($result, $converter, $converter_init_errors); |
| } |
| |
| sub convert_to_xml($$$$$) |
| { |
| my $self = shift; |
| my $test_name = shift; |
| my $format = shift; |
| my $document = shift; |
| my $converter_options = shift; |
| |
| $converter_options |
| = set_converter_option_defaults($converter_options, 'xml', |
| $self->{'DEBUG'}); |
| |
| my $converter = Texinfo::Example::TexinfoXML->converter($converter_options); |
| |
| my ($result, $converter_init_errors) = _convert($converter, $document, |
| (defined($converter_options->{'OUTFILE'}) |
| and $converter_options->{'OUTFILE'} eq '')); |
| return ($result, $converter, $converter_init_errors); |
| } |
| |
| sub convert_to_docbook($$$$$) |
| { |
| my $self = shift; |
| my $test_name = shift; |
| my $format = shift; |
| my $document = shift; |
| my $converter_options = shift; |
| |
| $converter_options |
| = set_converter_option_defaults($converter_options, 'docbook', |
| $self->{'DEBUG'}); |
| |
| my $tree = $document->tree(); |
| |
| # 'before_node_section' is normally ignored in conversion to DocBook and |
| # it is the type, in 'document_root' that holds content that appear before |
| # @node and sectioning command. To be able to have tests of simple |
| # Texinfo code without sectioning or @node command with DocBook, |
| # set the customization variable that mean that the document is not a |
| # full book. |
| if ($tree->{'contents'} and scalar(@{$tree->{'contents'}}) == 1) { |
| $converter_options->{'_DOCBOOK_PIECE'} = 1; |
| } |
| |
| #my $converter = Texinfo::Example::ReadDocBook->converter($converter_options); |
| my $converter = Texinfo::Convert::DocBook->converter($converter_options); |
| |
| my ($result, $converter_init_errors) = _convert($converter, $document, |
| (defined($converter_options->{'OUTFILE'}) |
| and $converter_options->{'OUTFILE'} eq '' |
| and $format ne 'docbook_doc')); |
| return ($result, $converter, $converter_init_errors); |
| } |
| |
| sub convert_to_latex($$$$$) |
| { |
| my $self = shift; |
| my $test_name = shift; |
| my $format = shift; |
| my $document = shift; |
| my $converter_options = shift; |
| |
| $converter_options |
| = set_converter_option_defaults($converter_options, 'latex', |
| $self->{'DEBUG'}); |
| |
| my $converter = Texinfo::Convert::LaTeX->converter($converter_options); |
| |
| my ($result, $converter_init_errors) |
| = _convert($converter, $document, $format eq 'latex_text'); |
| |
| return ($result, $converter, $converter_init_errors); |
| } |
| |
| sub output_preamble_postamble_html($$) |
| { |
| my $converter = shift; |
| my $postamble = shift; |
| |
| if ($postamble) { |
| return '</body> |
| </html> |
| ' |
| } else { |
| my $encoding = ''; |
| $encoding = "<meta http-equiv=\"Content-Type\" content=\"text/html; charset=". |
| $converter->get_conf('OUTPUT_ENCODING_NAME')."\">\n" |
| if (defined($converter->get_conf('OUTPUT_ENCODING_NAME')) |
| and ($converter->get_conf('OUTPUT_ENCODING_NAME') ne '')); |
| |
| return '<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd"> |
| <html> |
| <head> |
| <title>Untitled Document</title> |
| <meta name="resource-type" content="document"> |
| <meta name="distribution" content="global"> |
| <meta name="Generator" content="tta"> |
| '.$encoding |
| .&{$converter->formatting_function('format_css_lines')}($converter, |
| $converter->{'current_filename'}) |
| .'</head> |
| <body> |
| '; |
| } |
| } |
| |
| sub output_preamble_postamble_latex($$) |
| { |
| my $converter = shift; |
| my $postamble = shift; |
| my $parser_options = shift; |
| |
| if ($postamble) { |
| return '\end{document} |
| '; |
| } else { |
| my $begin_document = '\begin{document} |
| '; |
| if ($parser_options and $parser_options->{'full_document'}) { |
| $begin_document = ''; |
| } |
| return $converter->_latex_header() . $begin_document; |
| } |
| } |
| |
| sub _set_outfile_name($$$$) |
| { |
| my $test_file_name = shift; |
| my $test_name = shift; |
| my $extension = shift; |
| my $format = shift; |
| |
| my $original_test_outfile = "$test_file_name/$test_name.$extension"; |
| my $test_outfile = $original_test_outfile; |
| if ($output_files{$original_test_outfile}) { |
| warn "WARNING: $test_file_name: $test_name: $format: same name: $original_test_outfile " |
| ."(".join("|", @{$output_files{$original_test_outfile}}).")\n"; |
| push @{$output_files{$original_test_outfile}}, $format; |
| $test_outfile = "$test_file_name/${test_name}_${format}.$extension"; |
| # we also check that the file name with the format in name |
| # has not already been output |
| if ($output_files{$test_outfile}) { |
| warn "ERROR: $test_file_name: $test_name: $format: same name with format: $test_outfile\n"; |
| } else { |
| $output_files{$test_outfile} = [$format]; |
| } |
| } else { |
| $output_files{$original_test_outfile} = [$format]; |
| } |
| |
| return $test_outfile; |
| } |
| |
| my %tested_transformations; |
| |
| # Run a single test case. Each test case is an array |
| # [TEST_NAME, TEST_TEXT, PARSER_OPTIONS, CONVERTER_OPTIONS] |
| sub test($$) |
| { |
| my $self = shift; |
| my $test_case = shift; |
| |
| my $parser_options = {}; |
| my ($test_name, $test_text); |
| |
| my $tests_count = 0; |
| |
| $test_name = shift @$test_case; |
| die if (!defined($test_name)); |
| $test_text = shift @$test_case; |
| $parser_options = shift @$test_case if (scalar(@$test_case)); |
| my $converter_options; |
| if (scalar(@$test_case)) { |
| $converter_options = shift @$test_case; |
| } else { |
| $converter_options = {}; |
| } |
| |
| if (!defined($converter_options->{'XS_EXTERNAL_CONVERSION'}) |
| and defined($ENV{TEXINFO_XS_EXTERNAL_CONVERSION}) |
| and $ENV{TEXINFO_XS_EXTERNAL_CONVERSION}) { |
| $converter_options->{'XS_EXTERNAL_CONVERSION'} = 1; |
| } |
| if (!defined($converter_options->{'XS_EXTERNAL_FORMATTING'}) |
| and defined($ENV{TEXINFO_XS_EXTERNAL_FORMATTING}) |
| and $ENV{TEXINFO_XS_EXTERNAL_FORMATTING}) { |
| $converter_options->{'XS_EXTERNAL_FORMATTING'} = 1; |
| } |
| |
| if (!$self->{'generate'}) { |
| mkdir "t/results/$self->{'name'}" if (! -d "t/results/$self->{'name'}"); |
| } else { |
| mkdir $srcdir."/t/results/$self->{'name'}" |
| if (! -d $srcdir."/t/results/$self->{'name'}"); |
| } |
| |
| # keep track of expanded formats not being set to add epub only if |
| # loading the epub init file |
| my $default_expanded_formats; |
| if (!defined $parser_options->{'EXPANDED_FORMATS'}) { |
| $default_expanded_formats = 1; |
| $parser_options->{'EXPANDED_FORMATS'} = [ |
| 'docbook', 'html', 'info', 'plaintext', 'latex']; |
| # 'tex' is missed out here so that @ifnottex is expanded |
| # in the tests. Put |
| # {'EXPANDED_FORMATS' => ['tex']} |
| # where you need @tex expanded in the t/*.t files. |
| # 'xml', being deprecated, is not expanded in the default case either |
| } |
| my $initial_parser_options; |
| # keep initial parser options to be able to pass to preamble formatting |
| if ($arg_output) { |
| $initial_parser_options = dclone($parser_options); |
| } |
| |
| # get all the infos put in parser_options that are not actual |
| # parser options but specifications for the test. |
| my $test_file; |
| if ($parser_options->{'test_file'}) { |
| $test_file = $input_files_dir . $parser_options->{'test_file'}; |
| delete $parser_options->{'test_file'}; |
| } |
| my $full_document; |
| if (exists($parser_options->{'full_document'})) { |
| $full_document = $parser_options->{'full_document'}; |
| delete $parser_options->{'full_document'}; |
| } |
| my $test_input_file_name; |
| if ($parser_options->{'test_input_file_name'}) { |
| $test_input_file_name = $parser_options->{'test_input_file_name'}; |
| delete $parser_options->{'test_input_file_name'}; |
| } |
| # test_split_by_node should not interfere with output formats conversion |
| # as it is applied after the output formats. Splitting should not interfere |
| # with conversion anyway. Output formats using information added by |
| # splitting split themselves and reassociate all the root commands. |
| # Splitting means setting up output units and associating every root |
| # command to an output unit through 'associated_unit'. Converters that |
| # do not split ignore output units and the association of root commands |
| # with output units and therefore should not be affected either. |
| # Also the output units may be released when releasing conversion data. |
| |
| my $test_split_by_node = undef; |
| if ($parser_options->{'test_split'}) { |
| my $test_split = $parser_options->{'test_split'}; |
| if ($test_split eq 'node') { |
| $test_split_by_node = 1; |
| } elsif ($test_split eq 'section') { |
| $test_split_by_node = 0; |
| } else { |
| warn "test_utils.pl: test_split should be node or section: $test_split\n"; |
| } |
| delete $parser_options->{'test_split'}; |
| } |
| |
| my $additional_tree_transformations; |
| my %tree_transformations; |
| if ($parser_options->{'TREE_TRANSFORMATIONS'}) { |
| require Texinfo::Transformations; |
| Texinfo::Transformations->import(); |
| # Not valid tree transformation, but we want to test them anyway. |
| # There are other specific tests for comparison to texinfo, but here |
| # we also get the tree. |
| %tested_transformations = ( |
| 'protect_comma' => \&Texinfo::ManipulateTree::protect_comma_in_document, |
| 'protect_colon' => \&Texinfo::ManipulateTree::protect_colon_in_document, |
| 'protect_node_after_label' |
| => \&Texinfo::ManipulateTree::protect_node_after_label_in_document, |
| 'protect_first_parenthesis' |
| => \&Texinfo::Transformations::protect_first_parenthesis_in_targets_in_document, |
| 'protect_hashchar_at_line_beginning' |
| => \&Texinfo::Transformations::protect_hashchar_at_line_beginning_in_document, |
| ); |
| |
| my @option_transformations |
| = split /,/, $parser_options->{'TREE_TRANSFORMATIONS'}; |
| foreach my $transformation (@option_transformations) { |
| if (Texinfo::Common::valid_tree_transformation($transformation)) { |
| $tree_transformations{$transformation} = 1; |
| } elsif ($tested_transformations{$transformation}) { |
| $additional_tree_transformations = [] |
| if (!defined($additional_tree_transformations)); |
| push @$additional_tree_transformations, $transformation; |
| } else { |
| warn "$test_name: unknown tree transformation $transformation\n"; |
| } |
| } |
| delete $parser_options->{'TREE_TRANSFORMATIONS'}; |
| } |
| |
| if ($parser_options->{'skip'}) { |
| if (!$self->{'generate'}) { |
| SKIP: { |
| skip "$test_name: $parser_options->{'skip'}", 1; |
| ok(1, $test_name); |
| } |
| } |
| return 1; |
| } elsif (exists($parser_options->{'skip'})) { |
| delete $parser_options->{'skip'}; |
| } |
| |
| my %todos; |
| if ($parser_options->{'todo'}) { |
| %todos = %{$parser_options->{'todo'}}; |
| delete $parser_options->{'todo'}; |
| } |
| my $split_pages; |
| if ($parser_options->{'test_split_pages'}) { |
| $split_pages = $parser_options->{'test_split_pages'}; |
| delete $parser_options->{'test_split_pages'}; |
| } |
| |
| my @tested_formats; |
| if ($parser_options and $parser_options->{'test_formats'}) { |
| push @tested_formats, @{$parser_options->{'test_formats'}}; |
| delete $parser_options->{'test_formats'}; |
| } |
| |
| my $test_base_dir = "t/results/$self->{'name'}/$test_name/"; |
| |
| # set/reset converted formats output directories |
| foreach my $format (@tested_formats) { |
| if (defined($formats{$format})) { |
| my $format_type = $format; |
| if ($format_type =~ s/^file_//) { |
| my $base = $test_base_dir; |
| my $test_out_dir; |
| if ($self->{'generate'}) { |
| $base = $srcdir.'/'.$base; |
| $test_out_dir = $base.'res_'.$format_type; |
| if (-d $test_out_dir) { |
| unlink_dir_files($test_out_dir); |
| } |
| } else { |
| $test_out_dir = $base.'out_'.$format_type; |
| } |
| mkdir ($base) |
| if (! -d $base); |
| if (! -d $test_out_dir) { |
| mkdir ($test_out_dir); |
| } else { |
| # remove any files from previous runs |
| unlink glob ("$test_out_dir/*"); |
| } |
| } |
| } |
| } |
| |
| # Setup default customization options to be ready for init files options |
| # setting. |
| |
| my $test_customization_defaults = { |
| %Texinfo::Common::default_main_program_customization_options |
| }; |
| |
| my $doing_epub = 0; |
| my $loaded_init_files = 0; |
| |
| # get symbols in Texinfo::Config namespace before calling the init files |
| # such that the added symbols can be removed after running the tests to have |
| # isolated tests and be able to load the same init file multiple times. |
| my $symbols_before_init_file; |
| # reset Texinfo::Config informations to have isolated tests |
| Texinfo::Config::GNUT_reinitialize_init_files(); |
| my $init_files_options |
| = Texinfo::Config::GNUT_initialize_customization('', |
| $test_customization_defaults, {}); |
| my $init_file_directories = [$srcdir.'/init/', |
| $srcdir.'/t/init/', |
| $srcdir.'/ext/']; |
| # the init file names should be binary strings. Since they |
| # are not encoded here, ascii file names should be used or they |
| # should be encoded in test specification files. |
| if ($parser_options and $parser_options->{'init_files'}) { |
| $symbols_before_init_file = {}; |
| foreach my $symbol (keys(%Texinfo::Config::)) { |
| $symbols_before_init_file->{$symbol} = 1; |
| } |
| foreach my $filename (@{$parser_options->{'init_files'}}) { |
| my ($files, $deprecated_dirs_used) |
| = Texinfo::Common::locate_file_in_dirs($filename, |
| $init_file_directories, 0); |
| if (defined($files)) { |
| my $file = $files->[0]; |
| Texinfo::Config::GNUT_load_init_file($file); |
| if ($filename eq 'epub3.pm') { |
| $doing_epub = 1; |
| if ($default_expanded_formats) { |
| push @{$parser_options->{'EXPANDED_FORMATS'}}, 'epub'; |
| } |
| my $create_epub_file = $arg_output; |
| if ($arg_output) { |
| eval { require Archive::Zip; }; |
| my $archive_zip_loading_error = $@; |
| |
| $create_epub_file = 0 if ($archive_zip_loading_error); |
| } |
| if ($create_epub_file) { |
| # output EPUB as an epub publication file by setting OUTFILE. |
| # EPUB_CREATE_CONTAINER_FILE should be set in the default case. |
| my $extension = 'epub'; |
| mkdir ("$output_files_dir/$self->{'name'}") |
| if (! -d "$output_files_dir/$self->{'name'}"); |
| my $test_outfile = _set_outfile_name($self->{'name'}, $test_name, |
| $extension, 'epub'); |
| my $outfile = "$output_files_dir/$test_outfile"; |
| $converter_options->{'OUTFILE'} = $outfile; |
| } elsif (!defined($converter_options->{'EPUB_CREATE_CONTAINER_FILE'})) { |
| # we override init_files_options, as the priority between |
| # converter_options and init_files_options is not well defined. |
| $init_files_options->{'EPUB_CREATE_CONTAINER_FILE'} = 0; |
| } |
| } else { |
| $loaded_init_files++; |
| } |
| } else { |
| warn (sprintf("could not read init file %s", $filename)); |
| } |
| } |
| delete $parser_options->{'init_files'}; |
| } |
| |
| # Setup test configuration options at this point to remove |
| # structuring options from parser options. |
| my $test_customization_options = {}; |
| # gather options for structuring. |
| foreach my $structuring_option ('CHECK_NORMAL_MENU_STRUCTURE', |
| 'CHECK_MISSING_MENU_ENTRY', |
| # Not structuring options, but used for index sorting strings tests |
| 'USE_UNICODE_COLLATION', |
| 'COLLATION_LANGUAGE') { |
| if (defined($parser_options->{$structuring_option})) { |
| $test_customization_options->{$structuring_option} |
| = $parser_options->{$structuring_option}; |
| delete $parser_options->{$structuring_option}; |
| } |
| } |
| |
| my $completed_parser_options = |
| {'INCLUDE_DIRECTORIES' => [$srcdir.'/t/include/'], |
| 'DEBUG' => $self->{'DEBUG'}, |
| %$parser_options}; |
| |
| my $parser = Texinfo::Parser::parser($completed_parser_options); |
| |
| # take the initial values to record only if there is something new |
| my $initial_index_names |
| = Texinfo::Indices::print_indices_information( |
| \%Texinfo::Commands::index_names); |
| my $document; |
| if (!$test_file) { |
| if ($full_document) { |
| print STDERR " TEST FULL $test_name\n" if ($self->{'DEBUG'}); |
| $document = $parser->parse_texi_text($test_text); |
| } else { |
| print STDERR " TEST $test_name\n" if ($self->{'DEBUG'}); |
| $document = $parser->parse_texi_piece($test_text); |
| if (defined($test_input_file_name)) { |
| warn "ERROR: $self->{'name'}: $test_name: piece of texi with a file name\n"; |
| } |
| } |
| if (defined($test_input_file_name)) { |
| # argument should be byte strings. In most if not all cases, |
| # 'test_input_file_name' is based on $test_name. $test_name should |
| # only consist of ascii characters as it is used both as a |
| # character string and a byte string (see the comment below on that), |
| # so we do not encode, but we could if needed. If we encode, an |
| # output encoding should be determined. |
| $document->set_document_global_info('input_file_name', |
| $test_input_file_name); |
| } |
| } else { |
| print STDERR " TEST $test_name ($test_file)\n" if ($self->{'DEBUG'}); |
| $document = $parser->parse_texi_file($test_file); |
| } |
| |
| # Get the tree object. Note that if XS structuring in on, the argument |
| # prevents the tree being built as a Perl structure at this stage; only |
| # a "handle" is returned. |
| my $tree; |
| if (!$XS_structuring) { |
| $tree = $document->tree(); |
| # rebuild every information associated to the document, such that |
| # no flags of modified structure in C are set and XS code called |
| # to get document structures directly returns the Perl data. |
| $tree = Texinfo::Document::build_tree($tree); |
| } else { |
| $tree = $document->tree($XS_structuring); |
| } |
| |
| my $errors = $document->parser_errors(); |
| |
| my $indices; |
| |
| my $successful_parsing = 1; |
| |
| if (not defined($tree)) { |
| warn "ERROR: $test_name: parsing result undef\n"; |
| foreach my $error_message (@$errors) { |
| warn $error_message->{'error_line'} |
| if ($error_message->{'type'} eq 'error'); |
| } |
| $successful_parsing = 0; |
| goto COMPARE; |
| } |
| |
| # Setup main configuration options, used for structuring. |
| my $document_information = $document->global_information(); |
| |
| # setup a configuration Perl object which defines get_conf and set_conf, |
| # use the test customization information with per-document |
| # customization. This allows to use functions calling get_conf and |
| # set_conf to manipulate customization information. |
| # After this is done, the customization information should not |
| # change anymore, and it is registered in the document and used by |
| # Structuring/Transformations methods needing access to configuration |
| # information. |
| foreach my $parser_and_structuring_option ('FORMAT_MENU', 'DEBUG', |
| 'documentlanguage', |
| 'documentscript') { |
| if (exists($parser_options->{$parser_and_structuring_option})) { |
| $test_customization_options->{$parser_and_structuring_option} |
| = $parser_options->{$parser_and_structuring_option}; |
| } |
| } |
| if (!exists($parser_options->{'TEST'})) { |
| $test_customization_options->{'TEST'} = $default_test_level; |
| } else { |
| $test_customization_options->{'TEST'} = $parser_options->{'TEST'}; |
| } |
| |
| my $remove_references = 0; |
| my $test_level = $test_customization_options->{'TEST'}; |
| # used both for output units and tree elements |
| $remove_references = 1 if (defined($test_level) and $test_level > 1); |
| |
| # setup options from test specification (+DEBUG) as if they were |
| # command-line options, with high precedence. |
| foreach my $option (keys(%$test_customization_options)) { |
| Texinfo::Config::GNUT_set_from_cmdline($option, |
| $test_customization_options->{$option}); |
| } |
| |
| my $test_customization = Texinfo::MainConfig::new(); |
| |
| Texinfo::Common::set_output_encoding($test_customization, |
| $document); |
| |
| if ($document_information->{'novalidate'}) { |
| $test_customization->set_conf('novalidate', 1); |
| } |
| |
| $parser->release(); |
| $parser = undef; |
| |
| # Now that all the configuration has been set, register with the |
| # document |
| my $document_options = $test_customization->get_customization_options_hash(); |
| $document->register_document_options($document_options); |
| |
| if ($tree_transformations{'fill_gaps_in_sectioning'}) { |
| Texinfo::Transformations::fill_gaps_in_sectioning_in_document($document); |
| } |
| |
| if ($tree_transformations{'relate_index_entries_to_table_items'}) { |
| Texinfo::ManipulateTree::relate_index_entries_to_table_items_in_document( |
| $document); |
| } |
| |
| if ($tree_transformations{'move_index_entries_after_items'}) { |
| Texinfo::ManipulateTree::move_index_entries_after_items_in_document( |
| $document); |
| } |
| |
| if ($tree_transformations{'insert_nodes_for_sectioning_commands'}) { |
| Texinfo::Transformations::insert_nodes_for_sectioning_commands( |
| $document); |
| } |
| |
| Texinfo::Structuring::associate_internal_references($document); |
| |
| Texinfo::Structuring::sectioning_structure($document); |
| |
| Texinfo::Structuring::warn_non_empty_parts($document); |
| |
| if ($tree_transformations{'complete_tree_nodes_menus'}) { |
| Texinfo::Transformations::complete_tree_nodes_menus_in_document($document); |
| } elsif ($tree_transformations{'complete_tree_nodes_missing_menu'}) { |
| Texinfo::Transformations::complete_tree_nodes_missing_menu($document); |
| } |
| |
| if ($tree_transformations{'regenerate_master_menu'}) { |
| Texinfo::Transformations::regenerate_master_menu($document); |
| } |
| |
| Texinfo::Structuring::construct_nodes_tree($document); |
| |
| if (not defined($document->get_conf('FORMAT_MENU')) |
| or $document->get_conf('FORMAT_MENU') eq 'menu') { |
| Texinfo::Structuring::check_node_tree_menu_structure($document); |
| Texinfo::Structuring::complete_node_tree_with_menus($document); |
| |
| Texinfo::Structuring::check_nodes_are_referenced($document); |
| } |
| |
| Texinfo::Structuring::number_floats($document); |
| |
| if ($additional_tree_transformations) { |
| foreach my $transformation (@$additional_tree_transformations) { |
| my $tree_transformation_sub = $tested_transformations{$transformation}; |
| &$tree_transformation_sub($document); |
| } |
| } |
| |
| my $indices_info_text = $document->print_document_indices_information(); |
| # only print indices information if it differs from the default |
| # indices. Indices information is not about the entries. |
| $indices = $indices_info_text |
| unless($indices_info_text eq $initial_index_names); |
| |
| my $indices_sorted_sort_strings; |
| # We want to see the effect of init files registering a different |
| # function for translations, as it impacts the sort strings for |
| # object oriented definition commands. Therefore, if init files |
| # were read, we sort index strings using HTML converter functions. |
| # FIXME now the converter is not really used in |
| # print_document_indices_sort_strings call, so there is no point |
| # using a converter. It could be interesting to show the result |
| # of indices sort strings for each of the converter. |
| if ($loaded_init_files and !$doing_epub) { |
| my $format_converter_options = {%$converter_options, |
| %$init_files_options}; |
| my $converter_options |
| = set_converter_option_defaults($format_converter_options, 'html', |
| $self->{'DEBUG'}); |
| my $converter = Texinfo::Convert::HTML->converter($converter_options); |
| $indices_sorted_sort_strings |
| = $document->print_document_indices_sort_strings($converter); |
| } else { |
| $indices_sorted_sort_strings |
| = $document->print_document_indices_sort_strings(); |
| } |
| |
| $tree = $document->tree($XS_conversion); |
| |
| my $input_file_names_encoding |
| = Texinfo::Common::input_file_name_encoding( |
| $document->get_conf('INPUT_FILE_NAME_ENCODING'), |
| $document->get_conf('DOC_ENCODING_FOR_INPUT_FILE_NAME'), |
| $document->get_conf('LOCALE_ENCODING'), $document); |
| |
| # use the parser expanded formats to be similar to the main program, |
| # and also to avoid having @inline* and raw output format @-commands |
| # with elided contents especially parsed because they are ignored |
| # and appearing as raw content in the tree in the output. |
| my %expanded_formats; |
| if ($parser_options->{'EXPANDED_FORMATS'}) { |
| foreach my $expanded_format (@{$parser_options->{'EXPANDED_FORMATS'}}) { |
| $expanded_formats{$expanded_format} = 1; |
| } |
| } |
| my $text_options = {'TEST' => $default_test_level, |
| 'expanded_formats' => \%expanded_formats}; |
| if (defined($parser_options->{'COMMAND_LINE_ENCODING'})) { |
| $text_options->{'COMMAND_LINE_ENCODING'} |
| = $parser_options->{'COMMAND_LINE_ENCODING'}; |
| } |
| |
| my $converted_text |
| = Texinfo::Convert::Text::convert_to_text($tree, $text_options); |
| |
| # holds conversion function output returned as text for each format. |
| # Should not be set for formats outputting to files. |
| my %converted; |
| my %converted_errors; |
| |
| foreach my $format (@tested_formats) { |
| if (defined($formats{$format})) { |
| # If a key is in both, last one is kept, which means priority for |
| # init_files_options. |
| my $format_converter_options = {%$converter_options, |
| %$init_files_options}; |
| my $format_type = $format; |
| if ($format_type =~ s/^file_//) { |
| if ($format_type eq 'epub' and !$doing_epub) { |
| warn "ERROR: $self->{'name'}: $test_name: $format: init file not loaded\n"; |
| } |
| # the information that the results is a file is passed |
| # through $format_converter_options->{'SUBDIR'} being defined, |
| # except for EPUB, which set (and reuse) SUBDIR internally. |
| my $test_out_dir; |
| if ($self->{'generate'}) { |
| my $base = $srcdir.'/'.$test_base_dir; |
| $test_out_dir = $base.'res_'.$format_type; |
| } else { |
| my $base = $test_base_dir; |
| $test_out_dir = $base.'out_'.$format_type; |
| } |
| $format_converter_options->{'SUBDIR'} = "$test_out_dir/"; |
| } elsif (!defined($format_converter_options->{'OUTFILE'})) { |
| $format_converter_options->{'OUTFILE'} = ''; |
| } |
| $format_converter_options->{'TEST'} = $default_test_level |
| if (!exists($format_converter_options->{'TEST'})); |
| $format_converter_options->{'INCLUDE_DIRECTORIES'} = [ |
| $srcdir.'/t/include/']; |
| #print STDERR "Doing $test_name: $format\n"; |
| my ($converter, $converter_init_errors); |
| ($converted{$format}, $converter, $converter_init_errors) |
| = &{$formats{$format}}($self, $test_name, $format_type, |
| $document, $format_converter_options); |
| |
| if ($format =~ /^file_/ and defined($converted{$format})) { |
| # This is certainly wrong, because the differences are made on |
| # the output files which should be empty. Differences in output |
| # will be missed. It is tempting to use such format to have |
| # output() called by the converter and get the file headers and |
| # footers output in the main test perl file, but it is incorrect. |
| # It is better to do as for the html or latex cases, have a _text |
| # format, like html_text for which convert() is called and have |
| # output() be called for the main format name, for example html. |
| warn "ERROR: $self->{'name'}: $test_name: $format: file test with result as text\n"; |
| } |
| # output converted result and errors in files if $arg_output is set |
| if ($arg_output) { |
| # FIXME wrong for errors, should output errors after they have been |
| # collected. |
| mkdir ("$output_files_dir/$self->{'name'}") |
| if (! -d "$output_files_dir/$self->{'name'}"); |
| my $extension; |
| if ($extensions{$format_type}) { |
| $extension = $extensions{$format_type}; |
| } else { |
| $extension = $format_type; |
| } |
| if (defined ($converted{$format})) { |
| my $test_outfile |
| = _set_outfile_name($self->{'name'}, $test_name, |
| $extension, $format); |
| my $outfile = "$output_files_dir/$test_outfile"; |
| if (!open(OUTFILE, ">$outfile")) { |
| warn "ERROR: open $outfile: $!\n"; |
| } else { |
| my $output_encoding |
| = $converter->get_conf('OUTPUT_ENCODING_NAME'); |
| my $output_file_encoding |
| = Texinfo::Common::processing_output_encoding($output_encoding); |
| |
| if (defined($output_file_encoding) |
| and $output_file_encoding ne '') { |
| binmode(OUTFILE, ":encoding($output_file_encoding)"); |
| } else { |
| warn "WARNING: $self->{'name'}: $test_name: $format: no encoding\n"; |
| } |
| if ($outfile_preamble{$format}) { |
| if (ref($outfile_preamble{$format}) eq 'CODE') { |
| print OUTFILE &{$outfile_preamble{$format}}($converter, 0, |
| $initial_parser_options); |
| } else { |
| print OUTFILE $outfile_preamble{$format}->[0]; |
| } |
| } |
| print OUTFILE $converted{$format}; |
| if ($outfile_preamble{$format}) { |
| if (ref($outfile_preamble{$format}) eq 'CODE') { |
| print OUTFILE &{$outfile_preamble{$format}}($converter, 1, |
| $initial_parser_options); |
| } else { |
| print OUTFILE $outfile_preamble{$format}->[1]; |
| } |
| } |
| close (OUTFILE) or warn "Close $outfile: $!\n"; |
| } |
| } |
| if ($converted_errors{$format}) { |
| my $errors_file |
| = "$output_files_dir/$self->{'name'}/${test_name}_$format.err"; |
| if (!open(ERRFILE, ">$errors_file")) { |
| warn "Open $errors_file: $!\n"; |
| } else { |
| foreach my $error_message (@{$converted_errors{$format}}) { |
| my $error_line = $error_message->{'error_line'}; |
| if (defined($locale_encoding)) { |
| $error_line = Encode::encode($locale_encoding, $error_line); |
| } |
| if (defined($error_message->{'line_nr'})) { |
| $error_line = $error_message->{'line_nr'} . ':' . ' ' |
| . $error_line; |
| } |
| print ERRFILE $error_line; |
| } |
| close (ERRFILE) or warn "Close $errors_file: $!\n"; |
| } |
| } |
| } |
| $converter->converter_remove_output_units(); |
| $converter->destroy_converter(); |
| |
| my $converter_errors = [@{$converter_init_errors}]; |
| my $conversion_errors = $converter->get_converter_errors(); |
| push @{$converter_errors}, @{$conversion_errors}; |
| if (!scalar(@$converter_errors)) { |
| $converted_errors{$format} = undef; |
| } else { |
| $converted_errors{$format} |
| = Texinfo::Report::errors_print_details($converter_errors, |
| $input_file_names_encoding, 1); |
| } |
| |
| $converter = undef; |
| } |
| } |
| my $directions_text; |
| # remove the association of top-level commands with element units, in case |
| # a converter split the document. |
| # It may be noticed that this is only done after all conversions. This |
| # means that depending on the order of converters call, documents feed to |
| # converters may have element units if output units are not released. |
| # It could be possible to unsplit before each converter call, but it is |
| # better to check that this does not have an effect on conversion. |
| # Any conversion to Info, Plaintext or HTML (both with output and convert) |
| # leads to splitting by the converter, and generally the tests order is |
| # first plaintext or info then html, so splitting not having an effect |
| # on conversion should be fairly well tested. See above the comment |
| # near test_split_by_node with more explanation on why previous splitting |
| # should not interfere with conversion. |
| my $unsplit_needed = Texinfo::OutputUnits::unsplit($document); |
| print STDERR " UNSPLIT: $test_name\n" |
| if ($self->{'DEBUG'} and $unsplit_needed); |
| |
| # NOTE either a PlainTexinfo converter or a direct call to |
| # convert_to_texinfo can be used to test conversion back to Texinfo, |
| # both for pure Perl and XS. We use convert_to_texinfo as is should |
| # require less resources as there is no need to create a converter. |
| my $texi_result = Texinfo::Convert::Texinfo::convert_to_texinfo($tree); |
| |
| my $output_units |
| = Texinfo::OutputUnits::do_units_directions_pages($document, |
| $test_split_by_node, $split_pages, $self->{'DEBUG'}); |
| |
| my $errors_text; |
| my $float_text; |
| my $tree_text; |
| my $nodes_list_text; |
| my $sections_list_text; |
| my $sectioning_root_text; |
| my $headings_list_text; |
| if ($output_units) { |
| $tree_text |
| = Texinfo::OutputUnits::print_output_units_tree_details($output_units, |
| $tree, $input_file_names_encoding, 1); |
| if ($remove_references) { |
| Texinfo::OutputUnits::release_output_units_list($output_units); |
| } |
| } else { |
| $tree_text = Texinfo::ManipulateTree::tree_print_details($tree, |
| $input_file_names_encoding, 1); |
| } |
| |
| $float_text = Texinfo::Structuring::print_document_listoffloats($document); |
| |
| $nodes_list_text = Texinfo::Structuring::print_nodes_list($document); |
| |
| $sections_list_text = Texinfo::Structuring::print_sections_list($document); |
| |
| $sectioning_root_text |
| = Texinfo::Structuring::print_sectioning_root($document); |
| |
| $headings_list_text = Texinfo::Structuring::print_headings_list($document); |
| |
| # this is needed to avoid a last reference on the tree root when checking |
| # with C code that there are no references left. |
| $tree = undef; |
| |
| Texinfo::Document::destroy_document($document, $remove_references); |
| |
| my $document_errors = $document->errors(); |
| push @$errors, @$document_errors; |
| |
| $errors_text = Texinfo::Report::errors_print_details($errors, |
| $input_file_names_encoding, 1); |
| |
| COMPARE: |
| |
| my $file = "t/results/$self->{'name'}/$test_name.pl"; |
| my $new_file = $file.'.new'; |
| |
| if ($symbols_before_init_file) { |
| foreach my $symbol (keys(%Texinfo::Config::)) { |
| if (!$symbols_before_init_file->{$symbol}) { |
| delete $Texinfo::Config::{$symbol}; |
| } |
| } |
| } |
| |
| { |
| my $out_file; |
| if (!$self->{'generate'}) { |
| $out_file = $new_file; |
| } else { |
| $out_file = $srcdir.'/'.$file; |
| } |
| open(OUT, ">$out_file") or die "Open $out_file: $!\n"; |
| binmode (OUT, ":encoding(utf8)"); |
| print OUT |
| 'use vars qw(%result_texis %result_texts %result_tree_text %result_errors'."\n". |
| ' %result_indices %result_floats %result_nodes_list %result_sections_list'."\n". |
| ' %result_sectioning_root %result_headings_list'."\n". |
| ' %result_converted %result_converted_errors %result_indices_sort_strings);'."\n\n"; |
| print OUT 'use utf8;'."\n\n"; |
| |
| # NOTE $test_name is in general used for directories, file names, |
| # and messages. Here it is used as a text string. If non ascii, it |
| # should be a character string in internal perl codepoints as OUT |
| # is encoded as utf8. In that case, it should be encoded to be |
| # used as a file name for the above cases. Since this is not the case, |
| # $test_name should consist of ascii characters only. |
| my $out_result; |
| |
| if (defined($tree_text)) { |
| $out_result .= '$result_tree_text{\''.$test_name.'\'} = \'' |
| . protect_perl_string($tree_text)."';\n\n"; |
| } |
| |
| if (!$successful_parsing) { |
| goto END_OUT_FILE; |
| } |
| |
| $out_result .= "\n".'$result_texis{\''.$test_name.'\'} = \'' |
| .protect_perl_string($texi_result)."';\n\n"; |
| $out_result .= "\n".'$result_texts{\''.$test_name.'\'} = \'' |
| .protect_perl_string($converted_text)."';\n\n"; |
| |
| $out_result .= '$result_errors{\''.$test_name.'\'} = \'' |
| . protect_perl_string($errors_text)."';\n\n"; |
| |
| if (defined($indices)) { |
| $out_result .= '$result_indices{\''.$test_name.'\'} = \'' |
| . protect_perl_string($indices)."';\n\n"; |
| } |
| |
| if (defined($float_text)) { |
| $out_result .= '$result_floats{\''.$test_name.'\'} = \'' |
| . protect_perl_string($float_text)."';\n\n"; |
| } |
| |
| if (defined($nodes_list_text)) { |
| $out_result .= '$result_nodes_list{\''.$test_name.'\'} = \'' |
| . protect_perl_string($nodes_list_text)."';\n\n"; |
| } |
| |
| if (defined($sections_list_text)) { |
| $out_result .= '$result_sections_list{\''.$test_name.'\'} = \'' |
| . protect_perl_string($sections_list_text)."';\n\n"; |
| } |
| |
| if (defined($sectioning_root_text)) { |
| $out_result .= '$result_sectioning_root{\''.$test_name.'\'} = \'' |
| . protect_perl_string($sectioning_root_text)."';\n\n"; |
| } |
| |
| if (defined($headings_list_text)) { |
| $out_result .= '$result_headings_list{\''.$test_name.'\'} = \'' |
| . protect_perl_string($headings_list_text)."';\n\n"; |
| } |
| |
| if (defined($indices_sorted_sort_strings)) { |
| $out_result .= '$result_indices_sort_strings{\''.$test_name.'\'} = \'' |
| . protect_perl_string($indices_sorted_sort_strings)."';\n\n"; |
| } |
| |
| foreach my $format (@tested_formats) { |
| if (defined($converted{$format})) { |
| $out_result .= "\n".'$result_converted{\''.$format.'\'}->{\'' |
| .$test_name.'\'} = \'' |
| .protect_perl_string($converted{$format})."';\n\n"; |
| } |
| if (defined($converted_errors{$format})) { |
| $out_result |
| .= '$result_converted_errors{\''.$format.'\'}->{\''.$test_name.'\'} = \'' |
| . protect_perl_string($converted_errors{$format})."';\n\n"; |
| } |
| } |
| |
| END_OUT_FILE: |
| |
| $out_result .= "1;\n"; |
| print OUT $out_result; |
| close (OUT); |
| |
| if ($self->{'generate'}) { |
| print STDERR "--> $test_name\n"; |
| } |
| } |
| if (!$self->{'generate'}) { |
| %result_converted = (); |
| require "$srcdir/$file"; |
| |
| is_diff($tree_text, $result_tree_text{$test_name}, $test_name.' tree'); |
| |
| is_diff($float_text, $result_floats{$test_name}, $test_name.' floats'); |
| |
| is_diff($nodes_list_text, $result_nodes_list{$test_name}, $test_name |
| .' nodes list'); |
| |
| is_diff($sections_list_text, $result_sections_list{$test_name}, $test_name |
| .' sections list'); |
| |
| is_diff($sectioning_root_text, $result_sectioning_root{$test_name}, |
| $test_name .' sectioning root'); |
| |
| is_diff($headings_list_text, $result_headings_list{$test_name}, $test_name |
| .' headings list'); |
| |
| is_diff($errors_text, $result_errors{$test_name}, $test_name.' errors'); |
| |
| is_diff($indices, $result_indices{$test_name}, $test_name.' indices'); |
| is_diff($indices_sorted_sort_strings, |
| $result_indices_sort_strings{$test_name}, |
| $test_name.' indices sort'); |
| |
| is_diff($texi_result, $result_texis{$test_name}, $test_name.' texi'); |
| if ($todos{'text'}) { |
| SKIP: { |
| skip $todos{'text'}, 1; |
| is($converted_text, $result_texts{$test_name}, $test_name.' text'); |
| } |
| } else { |
| is_diff($converted_text, $result_texts{$test_name}, $test_name.' text'); |
| } |
| $tests_count = $nr_comparisons; |
| if (@tested_formats) { |
| foreach my $format (@tested_formats) { |
| my $reference_exists; |
| my $format_type = $format; |
| if ($format_type =~ s/^file_//) { |
| my $base = $test_base_dir; |
| my $reference_dir = "$srcdir/$base".'res_'.$format_type; |
| my $results_dir = $base.'out_'.$format_type; |
| if (-d $reference_dir) { |
| $reference_exists = 1; |
| $tests_count += 1; |
| my $dir_errors = compare_dirs_files($reference_dir, $results_dir); |
| |
| # compare *_epub_package/EPUB and *_epub_package/EPUB/xhtml |
| # contents too for epub |
| if (($format_type eq 'html' or $format_type eq 'epub') |
| and $doing_epub) { |
| my @epub_package_dirs; |
| if (opendir(RDIR, $reference_dir)) { |
| my @files = readdir (RDIR); |
| foreach my $file (@files) { |
| if ($file =~ /_epub_package$/) { |
| push @epub_package_dirs, $file; |
| } |
| } |
| } |
| my $used_dir; |
| foreach my $dir_name (@epub_package_dirs) { |
| my $reference_EPUB_dir; |
| my $reference_xhtml_dir; |
| my $ref_epub_package = join('/', ($reference_dir, $dir_name)); |
| if (-r $ref_epub_package and -d $ref_epub_package) { |
| $reference_EPUB_dir = join('/', ($ref_epub_package, 'EPUB')); |
| if (-r $reference_EPUB_dir and -d $reference_EPUB_dir) { |
| $used_dir = 1; |
| |
| my $results_EPUB_dir |
| = join('/', ($results_dir, $dir_name, 'EPUB')); |
| my $EPUB_dir_errors |
| = compare_dirs_files($reference_EPUB_dir, |
| $results_EPUB_dir); |
| if (defined($EPUB_dir_errors)) { |
| if (!defined($dir_errors)) { |
| $dir_errors = []; |
| } |
| push @$dir_errors, @$EPUB_dir_errors; |
| } |
| |
| $reference_xhtml_dir |
| = join('/', ($reference_EPUB_dir, 'xhtml')); |
| if (-r $reference_xhtml_dir and -d $reference_xhtml_dir) { |
| my $results_xhtml_dir |
| = join('/', ($results_EPUB_dir, 'xhtml')); |
| my $xhtml_dir_errors |
| = compare_dirs_files($reference_xhtml_dir, |
| $results_xhtml_dir); |
| if (defined($xhtml_dir_errors)) { |
| if (!defined($dir_errors)) { |
| $dir_errors = []; |
| } |
| push @$dir_errors, @$xhtml_dir_errors; |
| } |
| } |
| } |
| } |
| } |
| if (!$used_dir) { |
| warn "WARNING: $format $test_name: ". |
| "no suitable epub_package dir\n"; |
| } |
| } |
| if ($todos{$format}) { |
| SKIP: { |
| skip $todos{$format}, 1; |
| ok(!defined($dir_errors), $test_name.' converted '.$format) |
| or diag(join("\n", @$dir_errors)); |
| } |
| } else { |
| ok(!defined($dir_errors), $test_name.' converted '.$format) |
| or diag(join("\n", @$dir_errors)); |
| } |
| } else { |
| print STDERR "\n$format $test_name: \n$results_dir\n"; |
| } |
| } elsif (!defined($result_converted{$format})) { |
| my $result; |
| if (defined($converted{$format})) { |
| $result = $converted{$format}; |
| } else { |
| $result = 'UNDEF'."\n"; |
| } |
| print STDERR "\n$format $test_name:\n$result"; |
| } else { |
| $reference_exists = 1; |
| $tests_count += 1; |
| if ($todos{$format}) { |
| SKIP: { |
| skip $todos{$format}, 1; |
| is($converted{$format}, |
| $result_converted{$format}->{$test_name}, |
| $test_name.' converted '.$format); |
| } |
| } else { |
| is_diff($converted{$format}, |
| $result_converted{$format}->{$test_name}, |
| $test_name.' converted '.$format); |
| } |
| } |
| |
| # TODO for HTML format tests, it could be a good idea to produce |
| # and check a representation of global and text directions, |
| # including added and special units directions. |
| |
| if ($reference_exists) { |
| $tests_count += 1; |
| ok(((not defined($converted_errors{$format}) |
| and (not exists($result_converted_errors{$format}) |
| or not exists( |
| $result_converted_errors{$format}->{$test_name}))) |
| or (defined($converted_errors{$format}) |
| and exists($result_converted_errors{$format}) |
| and exists($result_converted_errors{$format}->{$test_name}) |
| and $converted_errors{$format} eq |
| $result_converted_errors{$format}->{$test_name})), |
| $test_name.' errors '.$format); |
| } |
| } |
| } |
| } |
| |
| return $tests_count; |
| } |
| |
| # Main entry point for the tests. Called from *.t files. |
| # $NAME - a string, name of test |
| # $TEST_CASES - array of sub-tests |
| # |
| # variables set from command line: |
| # If $ARG_TEST_CASE is set, only run that test. |
| # $ARG_GENERATE set means to generate reference test results (-g from command line). |
| # $ARG_DEBUG is used for debugging (-d from command line). |
| # The $ARG_COMPLETE variable is the -c option, to create Texinfo files for the |
| # test cases. |
| sub run_all($$) |
| { |
| my $name = shift; |
| my $test_cases = shift; |
| |
| my $test = new_test($name, $arg_generate, $arg_debug); |
| my $ran_tests; |
| if (scalar(@ARGV)) { |
| $ran_tests = []; |
| foreach my $arg_test_case (@ARGV) { |
| foreach my $test_case (@$test_cases) { |
| if ($test_case->[0] eq $arg_test_case) { |
| push @$ran_tests, $test_case; |
| last; |
| } |
| } |
| } |
| } else { |
| $ran_tests = $test_cases; |
| } |
| |
| if (!defined($ran_tests)) { |
| die "No test\n"; |
| } |
| my $test_nrs = 0; |
| |
| foreach my $test_case (@$ran_tests) { |
| if ($arg_complete) { |
| $test->output_texi_file($test_case); |
| } else { |
| $test_nrs += $test->test($test_case); |
| } |
| } |
| if ($arg_generate or $arg_complete) { |
| plan tests => 1; |
| } else { |
| plan tests => (1 + $test_nrs); |
| } |
| } |
| |
| # Create a Texinfo file for a test case; used when -c option is given. |
| sub output_texi_file($) |
| { |
| my $self = shift; |
| my $test_case = shift; |
| my $test_name = shift @$test_case; |
| my $test_text = shift @$test_case; |
| my $test_options = shift @$test_case; |
| |
| my $dir = "$generated_texis_dir/$self->{'name'}/"; |
| mkdir "$generated_texis_dir/" or die |
| unless (-d "$generated_texis_dir/"); |
| mkdir $dir or die |
| unless (-d $dir); |
| my $file = "${dir}$test_name.texi"; |
| print STDERR "texi: $test_name\n" if ($arg_debug); |
| open(OUTFILE, ">$file") or die ("Open $file: $!\n"); |
| |
| my $encode = 1; |
| my $first_line = "\\input texinfo \@c -*-texinfo-*-"; |
| my $from_file; |
| if (!defined($test_text)) { |
| $from_file = 1; |
| # We do not decode to character strings in internal perl encoding, |
| # we get bytes and output bytes already encoded, mixing with |
| # character strings containing ascii characters only. |
| my $test_file; |
| if ($test_options and $test_options->{'test_file'}) { |
| $encode = 0; |
| $test_file = $input_files_dir . $test_options->{'test_file'}; |
| if (open(INFILE, $test_file)) { |
| my $holdTerminator = $/; |
| undef $/; |
| $test_text = <INFILE>; |
| $/ = $holdTerminator; |
| } else { |
| die "Open $test_file: $!\n"; |
| } |
| } |
| } |
| my $node_top; |
| if ($test_text =~ /^\@node +top[\s,]/mi |
| or $test_text =~ /^\@node +top *$/mi) { |
| $node_top = ''; |
| } else { |
| $node_top = "\@node Top\n"; |
| unless ($test_text =~ /^\@top\s/m or $test_text =~ /^\@top *$/m) { |
| $node_top .= "\@top $test_name\n"; |
| } |
| } |
| my $added_chapter = ''; |
| unless ($test_text =~ /^\@(chapter|unnumbered|appendix)\s/m |
| or $test_text =~ /^\@(chapter|unnumbered|appendix) *$/m |
| or $test_text =~ /^\@node +chap/mi) { |
| # need a chapter or node after Top for LaTeX as Top node is ignored. |
| if ($node_top ne '') { |
| $added_chapter = "\@node chapter\n\@chapter chapter\n"; |
| } else { |
| print STDERR "WARNING: $test_name: top in test, no chapter added\n"; |
| } |
| } |
| if ($from_file) { |
| if ($node_top ne '' or $added_chapter ne '') { |
| # \A matches beginning of string, even with /m |
| if ($test_text =~ s/\A(\s*\\input texinfo(\.tex)? *\@.*)(\n|$)//m |
| or $test_text =~ s/\A(\s*\\input texinfo(\.tex)? *)(\n|$)//m) { |
| $first_line = $1; |
| } |
| } elsif ($test_text =~ /^\s*\\input texinfo(\.tex)? *\@/ |
| or $test_text =~ /\A\s*\\input texinfo(\.tex)? *$/m) { |
| $first_line = ""; |
| } |
| } |
| my $bye = ''; |
| if ($test_text !~ /\@bye *$/m |
| and $test_text !~ /\@bye[\@ ]/) { |
| $bye = '@bye'; |
| } |
| foreach my $output ($first_line, $node_top, $added_chapter) { |
| print OUTFILE "$output\n" |
| if ($output ne ''); |
| } |
| # $test_text is already encoded if read from a file, but if it is |
| # a test string from a *.t file code, it is a perl character string |
| # and is encoded here, to UTF-8 as it is the default Texinfo encoding. |
| $test_text = Encode::encode('UTF-8', $test_text) if ($encode); |
| # Always add a newline in the end. There may not be a newline for tests |
| # defined as strings ending right after a character. |
| chomp($test_text); |
| print OUTFILE $test_text."\n"; |
| print OUTFILE "$bye\n" if ($bye ne ''); |
| close (OUTFILE) or die "Close $file: $!\n"; |
| } |
| |
| 1; |