test_utils.pl 39 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194
  1. # $Id$
  2. # t/* test support for the Perl modules.
  3. #
  4. # Copyright 2010, 2011, 2012, 2013, 2014, 2015
  5. # Free Software Foundation, Inc.
  6. #
  7. # This program is free software; you can redistribute it and/or modify
  8. # it under the terms of the GNU General Public License as published by
  9. # the Free Software Foundation; either version 3 of the License,
  10. # or (at your option) any later version.
  11. #
  12. # This program is distributed in the hope that it will be useful,
  13. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15. # GNU General Public License for more details.
  16. #
  17. # You should have received a copy of the GNU General Public License
  18. # along with this program. If not, see <http://www.gnu.org/licenses/>.
  19. #
  20. # Original author: Patrice Dumas <pertusus@free.fr>
  21. use strict;
  22. use 5.006;
  23. BEGIN {
  24. require Texinfo::ModulePath;
  25. Texinfo::ModulePath::init(undef, undef, 'updirs' => 2);
  26. } # end BEGIN
  27. use Test::More;
  28. use Texinfo::Parser;
  29. use Texinfo::Convert::Text;
  30. use Texinfo::Convert::Texinfo;
  31. use Texinfo::Structuring;
  32. use Texinfo::Convert::Plaintext;
  33. use Texinfo::Convert::Info;
  34. use Texinfo::Convert::HTML;
  35. use Texinfo::Convert::TexinfoXML;
  36. use Texinfo::Convert::DocBook;
  37. use File::Basename;
  38. use File::Copy;
  39. use File::Compare; # standard since 5.004
  40. use Data::Dumper;
  41. use Data::Compare;
  42. use Test::Deep;
  43. use Storable qw(dclone); # standard in 5.007003
  44. #use Data::Diff;
  45. #use Data::Transformer;
  46. #use Struct::Compare;
  47. use Getopt::Long qw(GetOptions);
  48. # File: test_file option.
  49. # FIXME Is it really useful?
  50. use vars qw(%result_texis %result_texts %result_trees %result_errors
  51. %result_indices %result_sectioning %result_nodes %result_menus
  52. %result_floats %result_converted %result_converted_errors
  53. %result_elements %result_directions_text);
  54. my $strings_textdomain = 'texinfo_document';
  55. Locale::Messages->select_package ('gettext_pp');
  56. my $srcdir = $ENV{'srcdir'};
  57. my $locales_srcdir;
  58. if (defined($srcdir)) {
  59. $srcdir =~ s/\/*$/\//;
  60. $locales_srcdir = $srcdir;
  61. } else {
  62. $srcdir = '';
  63. $locales_srcdir = '.';
  64. }
  65. my $localesdir;
  66. foreach my $dir ("LocaleData", "$locales_srcdir/LocaleData") {
  67. if (-d $dir) {
  68. $localesdir = $dir;
  69. }
  70. }
  71. if (! defined($localesdir)) {
  72. warn "No locales directory found, some tests will fail\n";
  73. }
  74. Locale::Messages::bindtextdomain ('texinfo_document', $localesdir);
  75. my $generated_texis_dir = 't_texis';
  76. my $input_files_dir = $srcdir."t/input_files/";
  77. our $output_files_dir = 't/output_files/';
  78. foreach my $dir ('t', 't/results', $output_files_dir) {
  79. my $error;
  80. # to avoid a race conditon, first create the dir then test that it
  81. # exists
  82. mkdir $dir or $error = $!;
  83. if (! -d $dir) {
  84. die "mkdir $dir: $error\n";
  85. }
  86. }
  87. my $include_reference_dir = 't/include_reference';
  88. my $include_dir = 't/include_dir';
  89. if (! -d $include_dir) {
  90. mkdir $include_dir or die "mkdir $include_dir: $!\n";
  91. if (opendir DIR, $include_reference_dir) {
  92. my @files = grep {-f "$include_reference_dir/$_"} readdir DIR;
  93. closedir DIR;
  94. foreach my $file (@files) {
  95. copy ("$include_reference_dir/$file", "$include_dir/$file")
  96. or die "Copy $include_reference_dir/$file $include_dir/$file failed: $!\n";
  97. }
  98. } else {
  99. die "Opendir $include_reference_dir failed: $!\n";
  100. }
  101. }
  102. ok(1);
  103. our %formats = (
  104. 'plaintext' => \&convert_to_plaintext,
  105. 'file_plaintext' => \&convert_to_plaintext,
  106. 'info' => \&convert_to_info,
  107. 'file_info' => \&convert_to_info,
  108. 'html' => \&convert_to_html,
  109. 'file_html' => \&convert_to_html,
  110. 'html_text' => \&convert_to_html,
  111. 'xml' => \&convert_to_xml,
  112. 'file_xml' => \&convert_to_xml,
  113. 'docbook' => \&convert_to_docbook,
  114. 'file_docbook' => \&convert_to_docbook,
  115. );
  116. our %extensions = (
  117. 'plaintext' => 'txt',
  118. 'html_text' => 'html',
  119. 'xml' => 'xml',
  120. 'docbook' => 'dbk',
  121. );
  122. my %xml_converter_defaults
  123. = Texinfo::Convert::TexinfoXML::converter_defaults(undef, undef);
  124. my $XML_DTD_VERSION = $xml_converter_defaults{'TEXINFO_DTD_VERSION'};
  125. my %outfile_preamble = (
  126. 'docbook' => ['<?xml version="1.0"?>
  127. <!DOCTYPE book PUBLIC "-//OASIS//DTD DocBook XML V4.2//EN" "http://www.oasis-open.org/docbook/xml/4.2/docbookx.dtd" [
  128. <!ENTITY tex "TeX">
  129. <!ENTITY latex "LaTeX">
  130. ]>
  131. '. "<book lang=\"en\">\n", "</book>\n"],
  132. 'xml' => ['<?xml version="1.0"?>
  133. '."<!DOCTYPE texinfo PUBLIC \"-//GNU//DTD TexinfoML V${XML_DTD_VERSION}//EN\" \"http://www.gnu.org/software/texinfo/dtd/${XML_DTD_VERSION}/texinfo.dtd\">
  134. ".'<texinfo xml:lang="en">
  135. ', "</texinfo>\n"],
  136. 'html_text' => ['<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
  137. <html>
  138. <head>
  139. <title>Untitled Document</title>
  140. <meta name="resource-type" content="document">
  141. <meta name="distribution" content="global">
  142. <meta name="Generator" content="tp">
  143. <style type="text/css">
  144. <!--
  145. a.summary-letter {text-decoration: none}
  146. blockquote.indentedblock {margin-right: 0em}
  147. blockquote.smallindentedblock {margin-right: 0em; font-size: smaller}
  148. blockquote.smallquotation {font-size: smaller}
  149. div.display {margin-left: 3.2em}
  150. div.example {margin-left: 3.2em}
  151. div.lisp {margin-left: 3.2em}
  152. div.smalldisplay {margin-left: 3.2em}
  153. div.smallexample {margin-left: 3.2em}
  154. div.smalllisp {margin-left: 3.2em}
  155. kbd {font-style: oblique}
  156. pre.display {font-family: inherit}
  157. pre.format {font-family: inherit}
  158. pre.menu-comment {font-family: serif}
  159. pre.menu-preformatted {font-family: serif}
  160. pre.smalldisplay {font-family: inherit; font-size: smaller}
  161. pre.smallexample {font-size: smaller}
  162. pre.smallformat {font-family: inherit; font-size: smaller}
  163. pre.smalllisp {font-size: smaller}
  164. span.nocodebreak {white-space: nowrap}
  165. span.nolinebreak {white-space: nowrap}
  166. span.roman {font-family: serif; font-weight: normal}
  167. span.sansserif {font-family: sans-serif; font-weight: normal}
  168. ul.no-bullet {list-style: none}
  169. -->
  170. </style>
  171. </head>
  172. <body>
  173. ',
  174. '</body>
  175. </html>
  176. ']
  177. );
  178. our $arg_generate;
  179. our $arg_debug;
  180. our $arg_complete;
  181. our $arg_output;
  182. our $nr_comparisons = 8;
  183. Getopt::Long::Configure("gnu_getopt");
  184. GetOptions('g|generate' => \$arg_generate, 'd|debug=i' => \$arg_debug,
  185. 'c|complete' => \$arg_complete, 'o|output' => \$arg_output);
  186. our $arg_test_case = shift @ARGV;
  187. sub protect_perl_string($)
  188. {
  189. my $string = shift;
  190. $string =~ s/\\/\\\\/g;
  191. $string =~ s/'/\\'/g;
  192. return $string;
  193. }
  194. sub compare_dirs_files($$;$)
  195. {
  196. my $dir1 = shift;
  197. my $dir2 = shift;
  198. my $ignore_files = shift;
  199. my %dir1_files;
  200. my %dir2_files;
  201. my @errors;
  202. my %ignored_files_hash;
  203. foreach my $ignored_file (@$ignore_files) {
  204. $ignored_files_hash{$ignored_file} = 1;
  205. }
  206. if (opendir(DIR1, $dir1)) {
  207. my @files = readdir (DIR1);
  208. foreach my $file (@files) {
  209. next if (! -r "$dir1/$file" or ! -f "$dir1/$file"
  210. or $ignored_files_hash{$file});
  211. $dir1_files{$file} = 1;
  212. }
  213. closedir (DIR1);
  214. } else {
  215. push @errors, "readdir $dir1: $!";
  216. }
  217. if (opendir(DIR2, $dir2)) {
  218. my @files = readdir (DIR2);
  219. foreach my $file (@files) {
  220. next if (! -r "$dir2/$file" or ! -f "$dir2/$file"
  221. or $ignored_files_hash{$file});
  222. $dir2_files{$file} = 1;
  223. }
  224. closedir (DIR2);
  225. } else {
  226. push @errors, "readdir $dir2: $!";
  227. }
  228. if (scalar(@errors)) {
  229. return \@errors;
  230. }
  231. foreach my $file (sort(keys(%dir1_files))) {
  232. if ($dir2_files{$file}) {
  233. my $status = compare("$dir1/$file", "$dir2/$file");
  234. if ($status) {
  235. push @errors, "$dir1/$file and $dir2/$file differ: $status";
  236. }
  237. delete $dir2_files{$file};
  238. } else {
  239. push @errors, "No $file in $dir2";
  240. }
  241. }
  242. foreach my $file (sort(keys(%dir2_files))) {
  243. push @errors, "No $file in $dir1"
  244. }
  245. if (scalar(@errors)) {
  246. return \@errors;
  247. } else {
  248. return undef;
  249. }
  250. }
  251. #my $errors = compare_dirs_files('a', 'b',['nnn']);
  252. #if ($errors) {
  253. # foreach my $error (@$errors) {
  254. # warn $error."\n";
  255. # }
  256. #}
  257. sub unlink_dir_files($;$)
  258. {
  259. my $dir = shift;
  260. my $ignore_files = shift;
  261. my %ignored_files_hash;
  262. foreach my $ignored_file (@$ignore_files) {
  263. $ignored_files_hash{$ignored_file} = 1;
  264. }
  265. if (opendir(DIR, $dir)) {
  266. my @files = readdir (DIR);
  267. foreach my $file (@files) {
  268. next if (! -f "$dir/$file"
  269. or $ignored_files_hash{$file});
  270. unlink "$dir/$file" or warn "Could not unlink $dir/$file: $!\n";
  271. }
  272. closedir (DIR);
  273. } else {
  274. warn "readdir $dir: $!";
  275. }
  276. }
  277. #my $remove_parent = sub {my $h = shift; delete $h->{'parent'}};
  278. #my $transformer = Data::Transformer->new('hash'=>$remove_parent);
  279. sub remove_keys($$;$);
  280. sub remove_keys($$;$)
  281. {
  282. my $root = shift;
  283. my $deleted_keys = shift;
  284. my $been_there = shift;
  285. return undef if (!defined($root));
  286. if (!defined($been_there)) {
  287. #print STDERR "First call: $root\n";
  288. $root = dclone ($root);
  289. #print STDERR Data::Dumper->Dump([$root]);
  290. $been_there = {};
  291. }
  292. #print STDERR "remove_keys: $root\n";
  293. if (ref($root) eq 'HASH') {
  294. foreach my $key (@$deleted_keys) {
  295. if (exists($root->{$key})) {
  296. delete ($root->{$key});
  297. #print STDERR "Deleted $root $key\n";
  298. }
  299. }
  300. $been_there->{$root} = 1;
  301. foreach my $key (keys(%$root)) {
  302. next if (!defined($root->{$key}) or !ref($root->{$key})
  303. or (ref($root->{$key}) ne 'HASH'
  304. and ref($root->{$key}) ne 'ARRAY')
  305. or exists($been_there->{$root->{$key}}));
  306. #print STDERR "Recurse in $root $key\n";
  307. remove_keys($root->{$key}, $deleted_keys, $been_there);
  308. }
  309. } elsif (ref($root) eq 'ARRAY') {
  310. $been_there->{$root} = 1;
  311. foreach my $element (@$root) {
  312. next if (!defined($element) or !ref($element)
  313. or (ref($element) ne 'HASH'
  314. and ref($element) ne 'ARRAY')
  315. or exists($been_there->{$element}));
  316. remove_keys($element, $deleted_keys, $been_there);
  317. }
  318. }
  319. return $root;
  320. }
  321. sub cmp_trimmed($$$$)
  322. {
  323. my $compared = shift;
  324. my $reference = shift;
  325. my $deleted_keys = shift;
  326. my $test_name = shift;
  327. my $trimmed = remove_keys($compared, $deleted_keys);
  328. no warnings 'recursion';
  329. Test::Deep::cmp_deeply($trimmed, $reference, $test_name);
  330. }
  331. sub new_test($;$$$)
  332. {
  333. my $name = shift;
  334. my $generate = shift;
  335. my $debug = shift;
  336. my $test_formats = shift;
  337. my $test = {'name' => $name, 'generate' => $generate,
  338. 'DEBUG' => $debug, 'test_formats' => $test_formats};
  339. if ($generate) {
  340. mkdir "t/results/$name" if (! -d "t/results/$name");
  341. }
  342. bless $test;
  343. return $test;
  344. }
  345. my @contents_keys = ('contents', 'args', 'parent', 'line_nr', 'node_content',
  346. 'nodes_manuals', 'misc_content', 'invalid_nesting',
  347. 'block_command_line_contents', 'spaces_after_command');
  348. my @menus_keys = ('menu_next', 'menu_up', 'menu_prev', 'menu_up_hash');
  349. my @sections_keys = ('section_next', 'section_prev', 'section_up',
  350. 'section_childs', 'associated_node', 'part_associated_section',
  351. 'toplevel_prev', 'toplevel_next', 'toplevel_up');
  352. my @node_keys = ('node_next', 'node_prev', 'node_up', 'menus',
  353. 'associated_section');
  354. my %avoided_keys_tree;
  355. our @avoided_keys_tree = (@sections_keys, @menus_keys, @node_keys,
  356. 'menu_child', 'element_next', 'directions', 'page_next', 'remaining_args');
  357. foreach my $avoided_key(@avoided_keys_tree) {
  358. $avoided_keys_tree{$avoided_key} = 1;
  359. }
  360. sub filter_tree_keys { [grep {!$avoided_keys_tree{$_}} ( sort keys %{$_[0]} )] }
  361. #my @avoided_compare_tree = (@avoided_keys_tree, 'parent', 'node_tree');
  362. my %avoided_keys_sectioning;
  363. my @avoided_keys_sectioning = ('section_next', @contents_keys, @menus_keys,
  364. @node_keys, 'menu_child', 'toplevel_next');
  365. foreach my $avoided_key(@avoided_keys_sectioning) {
  366. $avoided_keys_sectioning{$avoided_key} = 1;
  367. }
  368. sub filter_sectioning_keys { [grep {!$avoided_keys_sectioning{$_}}
  369. ( sort keys %{$_[0]} )] }
  370. my %avoided_keys_nodes;
  371. my @avoided_keys_nodes = (@sections_keys, @contents_keys, @menus_keys);
  372. foreach my $avoided_key(@avoided_keys_nodes) {
  373. $avoided_keys_nodes{$avoided_key} = 1;
  374. }
  375. sub filter_nodes_keys { [grep {!$avoided_keys_nodes{$_}}
  376. ( sort keys %{$_[0]} )] }
  377. #my @avoided_compare_nodes = (@avoided_keys_nodes, 'node_up', 'node_prev');
  378. my %avoided_keys_menus;
  379. my @avoided_keys_menus = (@sections_keys, @contents_keys, @node_keys);
  380. foreach my $avoided_key(@avoided_keys_menus) {
  381. $avoided_keys_menus{$avoided_key} = 1;
  382. }
  383. sub filter_menus_keys { [grep {!$avoided_keys_menus{$_}}
  384. ( sort keys %{$_[0]} )] }
  385. my %avoided_keys_floats;
  386. my @avoided_keys_floats = (@sections_keys, @contents_keys, @node_keys,
  387. @menus_keys);
  388. foreach my $avoided_key(@avoided_keys_floats) {
  389. $avoided_keys_floats{$avoided_key} = 1;
  390. }
  391. sub filter_floats_keys { [grep {!$avoided_keys_floats{$_}}
  392. ( sort keys %{$_[0]} )] }
  393. my %avoided_keys_elements;
  394. my @avoided_keys_elements = (@contents_keys, @sections_keys, @node_keys,
  395. 'element_next', 'element_prev');
  396. foreach my $avoided_key(@avoided_keys_elements) {
  397. $avoided_keys_elements{$avoided_key} = 1;
  398. }
  399. sub filter_elements_keys {[grep {!$avoided_keys_elements{$_}}
  400. ( sort keys %{$_[0]} )] }
  401. sub set_converter_option_defaults($$$)
  402. {
  403. my $converter_options = shift;
  404. my $parser_options = shift;
  405. my $format = shift;
  406. $converter_options = {} if (!defined($converter_options));
  407. if (!defined($converter_options->{'expanded_formats'})) {
  408. $converter_options->{'expanded_formats'} = [$format];
  409. }
  410. return $converter_options;
  411. }
  412. sub close_files($)
  413. {
  414. my $converter = shift;
  415. my $converter_unclosed_files = $converter->converter_unclosed_files();
  416. if ($converter_unclosed_files) {
  417. foreach my $unclosed_file (keys(%$converter_unclosed_files)) {
  418. if (!close($converter_unclosed_files->{$unclosed_file})) {
  419. # FIXME or die?
  420. warn(sprintf("tp_utils.pl: error on closing %s: %s\n",
  421. $converter_unclosed_files->{$unclosed_file}, $!));
  422. }
  423. }
  424. }
  425. }
  426. sub convert_to_plaintext($$$$$$;$)
  427. {
  428. my $self = shift;
  429. my $test_name = shift;
  430. my $format = shift;
  431. my $tree = shift;
  432. my $parser = shift;
  433. my $parser_options = shift;
  434. my $converter_options = shift;
  435. $converter_options
  436. = set_converter_option_defaults($converter_options,
  437. $parser_options, $format);
  438. if (!defined($converter_options->{'OUTFILE'})
  439. and defined($converter_options->{'SUBDIR'})) {
  440. $converter_options->{'OUTFILE'}
  441. = $converter_options->{'SUBDIR'}.$test_name.".txt";
  442. }
  443. my $converter =
  444. Texinfo::Convert::Plaintext->converter({'DEBUG' => $self->{'DEBUG'},
  445. 'parser' => $parser,
  446. 'output_format' => 'plaintext',
  447. %$converter_options });
  448. my $result;
  449. if ($converter_options->{'OUTFILE'} eq '') {
  450. $result = $converter->convert($tree);
  451. } else {
  452. $result = $converter->output($tree);
  453. close_files($converter);
  454. $result = undef if (defined($result and $result eq ''));
  455. }
  456. my ($errors, $error_nrs) = $converter->errors();
  457. return ($errors, $result);
  458. }
  459. sub convert_to_info($$$$$;$)
  460. {
  461. my $self = shift;
  462. my $test_name = shift;
  463. my $format = shift;
  464. my $tree = shift;
  465. my $parser = shift;
  466. my $parser_options = shift;
  467. my $converter_options = shift;
  468. # FIXME plaintext too?
  469. $converter_options
  470. = set_converter_option_defaults($converter_options,
  471. $parser_options, $format);
  472. my $converter =
  473. Texinfo::Convert::Info->converter ({'DEBUG' => $self->{'DEBUG'},
  474. 'parser' => $parser,
  475. 'output_format' => 'info',
  476. %$converter_options });
  477. my $result = $converter->output($tree);
  478. close_files($converter);
  479. die if (!defined($converter_options->{'SUBDIR'}) and !defined($result));
  480. my ($errors, $error_nrs) = $converter->errors();
  481. return ($errors, $result);
  482. }
  483. sub convert_to_html($$$$$$;$)
  484. {
  485. my $self = shift;
  486. my $test_name = shift;
  487. my $format = shift;
  488. my $tree = shift;
  489. my $parser = shift;
  490. my $parser_options = shift;
  491. my $converter_options = shift;
  492. $converter_options
  493. = set_converter_option_defaults($converter_options,
  494. $parser_options, 'html');
  495. $converter_options->{'SPLIT'} = 0
  496. if ($format eq 'html_text'
  497. and !defined($parser_options->{'SPLIT'})
  498. and !defined($converter_options->{'SPLIT'}));
  499. if (!defined($converter_options->{'SIMPLE_MENU'})
  500. and $parser_options->{'SIMPLE_MENU'}) {
  501. $converter_options->{'SIMPLE_MENU'} = 1;
  502. }
  503. my $converter =
  504. Texinfo::Convert::HTML->converter ({'DEBUG' => $self->{'DEBUG'},
  505. 'parser' => $parser,
  506. 'output_format' => 'html',
  507. %$converter_options });
  508. my $result;
  509. if ($format eq 'html_text') {
  510. $result = $converter->convert($tree);
  511. } else {
  512. $result = $converter->output($tree);
  513. close_files($converter);
  514. }
  515. die if (!defined($converter_options->{'SUBDIR'}) and !defined($result));
  516. my ($errors, $error_nrs) = $converter->errors();
  517. return ($errors, $result);
  518. }
  519. sub convert_to_xml($$$$$$;$)
  520. {
  521. my $self = shift;
  522. my $test_name = shift;
  523. my $format = shift;
  524. my $tree = shift;
  525. my $parser = shift;
  526. my $parser_options = shift;
  527. my $converter_options = shift;
  528. $converter_options
  529. = set_converter_option_defaults($converter_options,
  530. $parser_options, 'xml');
  531. my $converter =
  532. Texinfo::Convert::TexinfoXML->converter ({'DEBUG' => $self->{'DEBUG'},
  533. 'parser' => $parser,
  534. 'output_format' => 'texinfoxml',
  535. %$converter_options });
  536. my $result;
  537. if (defined($converter_options->{'OUTFILE'})
  538. and $converter_options->{'OUTFILE'} eq '') {
  539. $result = $converter->convert($tree);
  540. } else {
  541. $result = $converter->output($tree);
  542. close_files($converter);
  543. $result = undef if (defined($result and $result eq ''));
  544. }
  545. my ($errors, $error_nrs) = $converter->errors();
  546. return ($errors, $result);
  547. }
  548. sub convert_to_docbook($$$$$$;$)
  549. {
  550. my $self = shift;
  551. my $test_name = shift;
  552. my $format = shift;
  553. my $tree = shift;
  554. my $parser = shift;
  555. my $parser_options = shift;
  556. my $converter_options = shift;
  557. $converter_options
  558. = set_converter_option_defaults($converter_options,
  559. $parser_options, 'docbook');
  560. my $converter =
  561. Texinfo::Convert::DocBook->converter ({'DEBUG' => $self->{'DEBUG'},
  562. 'parser' => $parser,
  563. 'output_format' => 'docbook',
  564. %$converter_options });
  565. my $result;
  566. if (defined($converter_options->{'OUTFILE'})
  567. and $converter_options->{'OUTFILE'} eq '') {
  568. $result = $converter->convert($tree);
  569. } else {
  570. $result = $converter->output($tree);
  571. close_files($converter);
  572. $result = undef if (defined($result and $result eq ''));
  573. }
  574. my ($errors, $error_nrs) = $converter->errors();
  575. return ($errors, $result);
  576. }
  577. # Run a single test case. Each test case is an array
  578. # [TEST_NAME, TEST_TEXT, PARSER_OPTIONS, CONVERTER_OPTIONS]
  579. sub test($$)
  580. {
  581. my $self = shift;
  582. my $test_case = shift;
  583. my $parser_options = {};
  584. my $converter_options = undef;
  585. my ($test_name, $test_text);
  586. my $tests_count = 0;
  587. $test_name = shift @$test_case;
  588. die if (!defined($test_name));
  589. $test_text = shift @$test_case;
  590. $parser_options = shift @$test_case if (@$test_case);
  591. $converter_options = shift @$test_case if (@$test_case);
  592. if (!defined $parser_options->{'expanded_formats'}) {
  593. $parser_options->{'expanded_formats'} = [
  594. 'docbook', 'html', 'xml', 'info', 'plaintext'];
  595. # 'tex' is missed out here so that @ifnottex is expanded
  596. # in the tests. Put
  597. # {'expanded_formats' => ['tex']}
  598. # where you need @tex expanded in the t/*.t files.
  599. }
  600. my $test_file;
  601. if ($parser_options->{'test_file'}) {
  602. $test_file = $input_files_dir . $parser_options->{'test_file'};
  603. delete $parser_options->{'test_file'};
  604. }
  605. my $test_input_file_name;
  606. if ($parser_options->{'test_input_file_name'}) {
  607. $test_input_file_name = $parser_options->{'test_input_file_name'};
  608. delete $parser_options->{'test_input_file_name'};
  609. }
  610. my $split = '';
  611. if ($parser_options->{'test_split'}) {
  612. $split = $parser_options->{'test_split'};
  613. if ($split ne 'node' and $split ne 'section') {
  614. warn "In test_utils.pl, test_split should be node or section, not $split\n";
  615. }
  616. delete $parser_options->{'test_split'};
  617. }
  618. my %todos;
  619. if ($parser_options->{'todo'}) {
  620. %todos = %{$parser_options->{'todo'}};
  621. delete $parser_options->{'todo'};
  622. }
  623. my $split_pages = '';
  624. if ($parser_options->{'test_split_pages'}) {
  625. $split_pages = $parser_options->{'test_split_pages'};
  626. delete $parser_options->{'test_split_pages'};
  627. }
  628. my @tested_formats;
  629. if ($parser_options and $parser_options->{'test_formats'}) {
  630. push @tested_formats, @{$parser_options->{'test_formats'}};
  631. delete $parser_options->{'test_formats'};
  632. #} elsif ($self->{'test_formats'}) {
  633. # push @tested_formats, @{$self->{'test_formats'}};
  634. }
  635. my $parser = Texinfo::Parser->parser({'TEST' => 1,
  636. 'include_directories' => [
  637. 't/include_dir/',
  638. 't/include/',
  639. $srcdir.'t/include/'],
  640. 'DEBUG' => $self->{'DEBUG'},
  641. %$parser_options});
  642. # take the initial values to record only if there is something new
  643. my $initial_index_names = $parser->indices_information();
  644. # do a copy to compare the values and not the references
  645. $initial_index_names = dclone($initial_index_names);
  646. print STDERR " TEST $test_name\n" if ($self->{'DEBUG'});
  647. my $result;
  648. if (!$test_file) {
  649. $result = $parser->parse_texi_text($test_text, 1);
  650. if (defined($test_input_file_name)) {
  651. $parser->{'info'}->{'input_file_name'} = $test_input_file_name;
  652. }
  653. } else {
  654. $result = $parser->parse_texi_file($test_file);
  655. }
  656. Texinfo::Structuring::associate_internal_references($parser);
  657. my $floats = $parser->floats_information();
  658. my $structure = Texinfo::Structuring::sectioning_structure($parser, $result);
  659. if ($structure) {
  660. Texinfo::Structuring::warn_non_empty_parts($parser);
  661. }
  662. Texinfo::Structuring::number_floats($floats);
  663. my $top_node = Texinfo::Structuring::nodes_tree($parser);
  664. my ($errors, $error_nrs) = $parser->errors();
  665. my $index_names = $parser->indices_information();
  666. # FIXME maybe it would be good to compare $merged_index_entries?
  667. my $merged_index_entries
  668. = Texinfo::Structuring::merge_indices($index_names);
  669. # only print indices information if it differs from the default
  670. # indices
  671. my $indices;
  672. my $trimmed_index_names = remove_keys($index_names, ['index_entries']);
  673. $indices->{'index_names'} = $trimmed_index_names
  674. unless (Data::Compare::Compare($trimmed_index_names, $initial_index_names));
  675. my $sorted_index_entries;
  676. if ($merged_index_entries) {
  677. $sorted_index_entries
  678. = Texinfo::Structuring::sort_indices_by_letter($parser,
  679. $merged_index_entries,
  680. $index_names);
  681. }
  682. if ($parser_options->{'SIMPLE_MENU'}) {
  683. require Texinfo::Transformations;
  684. $parser->Texinfo::Transformations::set_menus_to_simple_menu();
  685. }
  686. my $converted_text = Texinfo::Convert::Text::convert($result, {'TEST' => 1});
  687. my %converted;
  688. my %converted_errors;
  689. $converter_options = {} if (!defined($converter_options));
  690. foreach my $format (@tested_formats) {
  691. if (defined($formats{$format})) {
  692. my $format_converter_options = {%$converter_options};
  693. my $format_type = $format;
  694. if ($format_type =~ s/^file_//) {
  695. # the information that the results is a file is passed
  696. # through $format_converter_options->{'SUBDIR'} being defined
  697. my $base = "t/results/$self->{'name'}/$test_name/";
  698. my $test_out_dir;
  699. if ($self->{'generate'}) {
  700. $test_out_dir = 'res_'.$format_type;
  701. if (-d $base."$test_out_dir/") {
  702. unlink_dir_files("t/results/$self->{'name'}/$test_name/$test_out_dir/");
  703. }
  704. } else {
  705. $test_out_dir = 'out_'.$format_type;
  706. }
  707. if (!defined($format_converter_options->{'SUBDIR'})) {
  708. mkdir ($base)
  709. if (! -d $base);
  710. if (! -d $base."$test_out_dir/") {
  711. mkdir ($base."$test_out_dir/");
  712. } else {
  713. # remove any files from previous runs
  714. unlink glob ($base."$test_out_dir/*");
  715. }
  716. $format_converter_options->{'SUBDIR'}
  717. = $base."$test_out_dir/";
  718. }
  719. } elsif (!defined($format_converter_options->{'OUTFILE'})) {
  720. $format_converter_options->{'OUTFILE'} = '';
  721. }
  722. ($converted_errors{$format}, $converted{$format})
  723. = &{$formats{$format}}($self, $test_name, $format_type,
  724. $result, $parser,
  725. $parser_options, $format_converter_options);
  726. $converted_errors{$format} = undef if (!@{$converted_errors{$format}});
  727. if (defined($converted{$format}) and $format =~ /^file_/) {
  728. warn "Warning: output generated for $format by $test_name\n";
  729. }
  730. #print STDERR "$format: \n$converted{$format}";
  731. # output converted result and errors in files if $arg_output is set
  732. if ($arg_output) {
  733. mkdir ("$output_files_dir/$self->{'name'}")
  734. if (! -d "$output_files_dir/$self->{'name'}");
  735. my $extension;
  736. if ($extensions{$format}) {
  737. $extension = $extensions{$format};
  738. } else {
  739. $extension = $format;
  740. }
  741. if (defined ($converted{$format})) {
  742. my $outfile = "$output_files_dir/$self->{'name'}/$test_name.$extension";
  743. if (!open (OUTFILE, ">$outfile")) {
  744. warn "Open $outfile: $!\n";
  745. } else {
  746. my $info = $parser->global_informations();
  747. if ($info and $info->{'perl_encoding'}) {
  748. binmode(OUTFILE, ":encoding($info->{'perl_encoding'})");
  749. }
  750. if ($outfile_preamble{$format}) {
  751. print OUTFILE $outfile_preamble{$format}->[0];
  752. }
  753. print OUTFILE $converted{$format};
  754. if ($outfile_preamble{$format}) {
  755. print OUTFILE $outfile_preamble{$format}->[1];
  756. }
  757. close (OUTFILE) or warn "Close $outfile: $!\n";
  758. }
  759. }
  760. if ($converted_errors{$format}) {
  761. my $errors_file
  762. = "$output_files_dir/$self->{'name'}/${test_name}_$extension.err";
  763. if (!open (ERRFILE, ">$errors_file")) {
  764. warn "Open $errors_file: $!\n";
  765. } else {
  766. foreach my $error_message (@{$converted_errors{$format}}) {
  767. print ERRFILE $error_message->{'error_line'};
  768. }
  769. close (ERRFILE) or warn "Close $errors_file: $!\n";
  770. }
  771. }
  772. }
  773. }
  774. }
  775. my $directions_text;
  776. # re-associate top level command with the document_root in case a converter
  777. # split the document, by resetting their 'parent' key.
  778. # It may be noticed that this is only done after all conversions. This
  779. # means that depending on the order of converters call, trees feed to
  780. # converters may have a document_root as top level command parent or
  781. # elements. All the converters will have the document_root as argument.
  782. Texinfo::Structuring::_unsplit($result);
  783. my $elements;
  784. if ($split eq 'node') {
  785. $elements = Texinfo::Structuring::split_by_node($result);
  786. } elsif ($split eq 'section') {
  787. $elements = Texinfo::Structuring::split_by_section($result);
  788. }
  789. if ($split) {
  790. Texinfo::Structuring::elements_directions($parser, $elements);
  791. $directions_text = '';
  792. foreach my $element (@$elements) {
  793. $directions_text .= Texinfo::Structuring::_print_directions($element);
  794. }
  795. }
  796. if ($split_pages) {
  797. Texinfo::Structuring::split_pages($elements, $split_pages);
  798. }
  799. my $file = "t/results/$self->{'name'}/$test_name.pl";
  800. my $new_file = $file.'.new';
  801. my $split_result;
  802. if ($elements) {
  803. $split_result = $elements;
  804. } else {
  805. $split_result = $result;
  806. }
  807. {
  808. local $Data::Dumper::Purity = 1;
  809. local $Data::Dumper::Indent = 1;
  810. my $out_file = $new_file;
  811. $out_file = $file if ($self->{'generate'});
  812. mkdir "t/results/$self->{'name'}" if (! -d "t/results/$self->{'name'}");
  813. open (OUT, ">$out_file") or die "Open $out_file: $!\n";
  814. binmode (OUT, ":encoding(utf8)");
  815. print OUT 'use vars qw(%result_texis %result_texts %result_trees %result_errors '."\n".
  816. ' %result_indices %result_sectioning %result_nodes %result_menus'."\n".
  817. ' %result_floats %result_converted %result_converted_errors '."\n".
  818. ' %result_elements %result_directions_text);'."\n\n";
  819. print OUT 'use utf8;'."\n\n";
  820. #print STDERR "Generate: ".Data::Dumper->Dump([$result], ['$res']);
  821. my $out_result;
  822. {
  823. local $Data::Dumper::Sortkeys = \&filter_tree_keys;
  824. $out_result = Data::Dumper->Dump([$split_result], ['$result_trees{\''.$test_name.'\'}']);
  825. }
  826. my $texi_string_result = Texinfo::Convert::Texinfo::convert($result);
  827. $out_result .= "\n".'$result_texis{\''.$test_name.'\'} = \''
  828. .protect_perl_string($texi_string_result)."';\n\n";
  829. $out_result .= "\n".'$result_texts{\''.$test_name.'\'} = \''
  830. .protect_perl_string($converted_text)."';\n\n";
  831. {
  832. local $Data::Dumper::Sortkeys = \&filter_sectioning_keys;
  833. $out_result .= Data::Dumper->Dump([$structure],
  834. ['$result_sectioning{\''.$test_name.'\'}'])."\n"
  835. if ($structure);
  836. }
  837. if ($top_node) {
  838. {
  839. local $Data::Dumper::Sortkeys = \&filter_nodes_keys;
  840. $out_result .= Data::Dumper->Dump([$top_node], ['$result_nodes{\''.$test_name.'\'}'])."\n";
  841. }
  842. {
  843. local $Data::Dumper::Sortkeys = \&filter_menus_keys;
  844. $out_result .= Data::Dumper->Dump([$top_node], ['$result_menus{\''.$test_name.'\'}'])."\n";
  845. }
  846. }
  847. {
  848. local $Data::Dumper::Sortkeys = 1;
  849. $out_result .= Data::Dumper->Dump([$errors], ['$result_errors{\''.$test_name.'\'}']) ."\n\n";
  850. $out_result .= Data::Dumper->Dump([$indices], ['$result_indices{\''.$test_name.'\'}']) ."\n\n"
  851. if ($indices);
  852. }
  853. if ($floats) {
  854. local $Data::Dumper::Sortkeys = \&filter_floats_keys;
  855. $out_result .= Data::Dumper->Dump([$floats], ['$result_floats{\''.$test_name.'\'}']) ."\n\n";
  856. }
  857. if ($elements) {
  858. local $Data::Dumper::Sortkeys = \&filter_elements_keys;
  859. $out_result .= Data::Dumper->Dump([$elements], ['$result_elements{\''.$test_name.'\'}']) ."\n\n";
  860. $out_result .= "\n".'$result_directions_text{\''.$test_name.'\'} = \''
  861. .protect_perl_string($directions_text)."';\n\n";
  862. }
  863. foreach my $format (@tested_formats) {
  864. if (defined($converted{$format})) {
  865. $out_result .= "\n".'$result_converted{\''.$format.'\'}->{\''
  866. .$test_name.'\'} = \''.protect_perl_string($converted{$format})."';\n\n";
  867. #print STDERR "$format: \n$converted{$format}";
  868. }
  869. if (defined($converted_errors{$format})) {
  870. local $Data::Dumper::Sortkeys = 1;
  871. $out_result .= Data::Dumper->Dump([$converted_errors{$format}],
  872. ['$result_converted_errors{\''.$format.'\'}->{\''.$test_name.'\'}']) ."\n\n";
  873. #print STDERR "".Data::Dumper->Dump([$converted_errors{$format}]);
  874. }
  875. }
  876. $out_result .= "1;\n";
  877. print OUT $out_result;
  878. close (OUT);
  879. #if (ref($test_case) ne 'ARRAY') {
  880. # my $out_texi_file = "t/results/$self->{'name'}/$test_name.texi";
  881. # open (OUT, ">$out_texi_file") or die "Open $out_texi_file: $!\n";
  882. # print OUT $texi_string_result;
  883. # close (OUT);
  884. #}
  885. print STDERR "--> $test_name\n".Texinfo::Convert::Texinfo::convert($result)."\n"
  886. if ($self->{'generate'});
  887. }
  888. if (!$self->{'generate'}) {
  889. %result_converted = ();
  890. require "$srcdir$file";
  891. cmp_trimmed($split_result, $result_trees{$test_name}, \@avoided_keys_tree,
  892. $test_name.' tree');
  893. cmp_trimmed($structure, $result_sectioning{$test_name},
  894. \@avoided_keys_sectioning, $test_name.' sectioning' );
  895. cmp_trimmed($top_node, $result_nodes{$test_name}, \@avoided_keys_nodes,
  896. $test_name.' nodes');
  897. cmp_trimmed($top_node, $result_menus{$test_name}, \@avoided_keys_menus,
  898. $test_name.' menus');
  899. ok (Data::Compare::Compare($errors, $result_errors{$test_name}),
  900. $test_name.' errors');
  901. ok (Data::Compare::Compare($indices, $result_indices{$test_name}),
  902. $test_name.' indices');
  903. ok (Texinfo::Convert::Texinfo::convert($result) eq $result_texis{$test_name},
  904. $test_name.' texi');
  905. if ($todos{'text'}) {
  906. #TODO: {
  907. #local $TODO = $todos{'text'};
  908. SKIP: {
  909. skip $todos{'text'}, 1;
  910. ok ($converted_text eq $result_texts{$test_name}, $test_name.' text');
  911. }
  912. } else {
  913. ok ($converted_text eq $result_texts{$test_name}, $test_name.' text');
  914. }
  915. $tests_count = $nr_comparisons;
  916. if (defined($result_directions_text{$test_name})) {
  917. cmp_trimmed($elements, $result_elements{$test_name},
  918. \@avoided_keys_elements, $test_name.' elements');
  919. $tests_count++;
  920. ok ($directions_text eq $result_directions_text{$test_name},
  921. $test_name.' directions text');
  922. $tests_count++;
  923. }
  924. if (@tested_formats) {
  925. foreach my $format (@tested_formats) {
  926. my $reference_exists;
  927. my $format_type = $format;
  928. if ($format_type =~ s/^file_//) {
  929. my $base = "t/results/$self->{'name'}/$test_name/";
  930. my $reference_dir = "$srcdir$base".'res_'.$format_type;
  931. my $results_dir = $base.'out_'.$format_type;
  932. if (-d $reference_dir) {
  933. $reference_exists = 1;
  934. $tests_count += 1;
  935. my $errors = compare_dirs_files($reference_dir, $results_dir);
  936. if ($todos{$format}) {
  937. #TODO: {
  938. # local $TODO = $todos{$format};
  939. SKIP: {
  940. skip $todos{$format}, 1;
  941. ok (!defined($errors), $test_name.' converted '.$format)
  942. or diag (join("\n", @$errors));
  943. }
  944. } else {
  945. ok (!defined($errors), $test_name.' converted '.$format)
  946. or diag (join("\n", @$errors));
  947. }
  948. } else {
  949. print STDERR "\n$format $test_name: \n$results_dir\n";
  950. }
  951. } elsif (!defined($result_converted{$format})) {
  952. my $result;
  953. if (defined($converted{$format})) {
  954. $result = $converted{$format};
  955. } else {
  956. $result = 'UNDEF'."\n";
  957. }
  958. print STDERR "\n$format $test_name:\n$result";
  959. } else {
  960. $reference_exists = 1;
  961. $tests_count += 1;
  962. if ($todos{$format}) {
  963. TODO: {
  964. local $TODO = $todos{$format};
  965. ok ($converted{$format}
  966. eq $result_converted{$format}->{$test_name},
  967. $test_name.' converted '.$format);
  968. }
  969. } else {
  970. ok ($converted{$format}
  971. eq $result_converted{$format}->{$test_name},
  972. $test_name.' converted '.$format);
  973. }
  974. }
  975. if ($reference_exists) {
  976. $tests_count += 1;
  977. ok (Data::Compare::Compare($converted_errors{$format},
  978. $result_converted_errors{$format}->{$test_name}),
  979. $test_name.' errors '.$format);
  980. }
  981. #print STDERR "$format: \n$converted{$format}";
  982. }
  983. }
  984. #is (Texinfo::Convert::Texinfo::convert($result), $result_texis{$test_name}, $test_name.' text');
  985. }
  986. #exit;
  987. return $tests_count;
  988. }
  989. # Main entry point for the tests.
  990. # $NAME - a string, name of test
  991. # $TEST_CASES - array of sub-tests
  992. # If $TEST_CASE_NAME is given, only run that test.
  993. # $GENERATE means to generate reference test results (-g from command line).
  994. # $DEBUG for debugging.
  995. # The $ARG_COMPLETE variable is the -c option, to create Texinfo files for the
  996. # test cases.
  997. sub run_all($$;$$$)
  998. {
  999. my $name = shift;
  1000. my $test_cases = shift;
  1001. my $test_case_name = shift;
  1002. my $generate = shift;
  1003. my $debug = shift;
  1004. my $test = new_test($name, $generate, $debug);
  1005. my $ran_tests;
  1006. if (defined($test_case_name)) {
  1007. if ($test_case_name =~ /^\d+$/) {
  1008. $ran_tests = [ $test_cases->[$test_case_name-1] ];
  1009. } else {
  1010. foreach my $test_case (@$test_cases) {
  1011. if ($test_case->[0] eq $test_case_name) {
  1012. $ran_tests = [ $test_case ];
  1013. last;
  1014. }
  1015. }
  1016. }
  1017. } else {
  1018. $ran_tests = $test_cases;
  1019. }
  1020. if (!defined($ran_tests)) {
  1021. die "No test\n";
  1022. }
  1023. my $test_nrs = 0;
  1024. foreach my $test_case (@$ran_tests) {
  1025. if ($arg_complete) {
  1026. $test->output_texi_file($test_case);
  1027. } else {
  1028. $test_nrs += $test->test($test_case);
  1029. }
  1030. }
  1031. if ($generate or $arg_complete) {
  1032. plan tests => 1;
  1033. } else {
  1034. plan tests => (1 + $test_nrs);
  1035. }
  1036. }
  1037. # Create a Texinfo file for a test case; used when -c option is given.
  1038. sub output_texi_file($)
  1039. {
  1040. my $self = shift;
  1041. my $test_case = shift;
  1042. my $test_name = shift @$test_case;
  1043. my $test_text = shift @$test_case;
  1044. my $test_options = shift @$test_case;
  1045. my $dir = "$generated_texis_dir/$self->{'name'}/";
  1046. mkdir "$generated_texis_dir/" or die
  1047. unless (-d "$generated_texis_dir/");
  1048. mkdir $dir or die
  1049. unless (-d $dir);
  1050. my $file = "${dir}$test_name.texi";
  1051. open (OUTFILE, ">$file") or die ("Open $file: $!\n");
  1052. my $first_line = "\\input texinfo \@c -*-texinfo-*-";
  1053. if (!defined($test_text)) {
  1054. my $test_file;
  1055. if ($test_options and $test_options->{'test_file'}) {
  1056. $test_file = $input_files_dir . $test_options->{'test_file'};
  1057. if (open (INFILE, $test_file)) {
  1058. my $holdTerminator = $/;
  1059. undef $/;
  1060. $test_text = <INFILE>;
  1061. $/ = $holdTerminator;
  1062. } else {
  1063. die "Open $test_file: $!\n";
  1064. }
  1065. if ($test_text =~ /^\\input texinfo *\@/m
  1066. or $test_text =~ /^\\input texinfo *$/m) {
  1067. $first_line = "";
  1068. }
  1069. }
  1070. }
  1071. my $setfilename;
  1072. if ($test_text =~ /^\@setfilename/m) {
  1073. $setfilename = ''
  1074. } else {
  1075. $setfilename = "\@setfilename $test_name.info\n";
  1076. }
  1077. my $node_top;
  1078. my $top = '';
  1079. if ($test_text =~ /^\@node +top[\s,]/mi or $test_text =~ /^\@node +top *$/mi) {
  1080. $node_top = '';
  1081. } else {
  1082. $node_top = "\@node Top\n";
  1083. unless ($test_text =~ /^\@top\s/m or $test_text =~ /^\@top *$/m) {
  1084. $node_top .= "\@top $test_name\n";
  1085. }
  1086. }
  1087. my $bye = '';
  1088. if ($test_text !~ /^\@bye *$/m) {
  1089. $bye = '@bye';
  1090. }
  1091. print OUTFILE "$first_line
  1092. $setfilename
  1093. $node_top
  1094. $test_text
  1095. $bye\n";
  1096. close (OUTFILE) or die "Close $file: $!\n";
  1097. }
  1098. 1;