File Coverage

blib/lib/LaTeXML/Util/Test.pm
Criterion Covered Total %
statement 44 202 21.7
branch 6 84 7.1
condition 0 16 0.0
subroutine 12 24 50.0
pod 0 13 0.0
total 62 339 18.2


line stmt bran cond sub pod time code
1             package LaTeXML::Util::Test;
2 21     21   7162 use strict;
  21         22  
  21         494  
3 21     21   63 use warnings;
  21         20  
  21         408  
4              
5 21     21   11291 use Test::More;
  21         257264  
  21         137  
6 21     21   12990 use LaTeXML::Util::Pathname;
  21         43  
  21         3452  
7 21     21   12466 use JSON::XS;
  21         92298  
  21         1037  
8 21     21   8525 use FindBin;
  21         15570  
  21         725  
9 21     21   97 use File::Copy;
  21         21  
  21         694  
10 21     21   73 use File::Which;
  21         22  
  21         575  
11 21     21   8418 use File::Spec::Functions;
  21         11198  
  21         1269  
12 21     21   88 use base qw(Exporter);
  21         19  
  21         34486  
13             # @Test::More::EXPORT);
14             our @EXPORT = (qw(&latexml_ok &latexml_tests),
15             @Test::More::EXPORT);
16             my $kpsewhich = which($ENV{LATEXML_KPSEWHICH} || 'kpsewhich'); # [CONFIGURATION]
17             # Note that this is a singlet; the same Builder is shared.
18              
19             # Test the conversion of all *.tex files in the given directory (typically t/something)
20             # Skip any that have no corresponding *.xml file.
21             sub latexml_tests {
22 21     21 0 175 my ($directory, %options) = @_;
23 21         29 my $DIR;
24 21 50       1071 if (!opendir($DIR, $directory)) {
25             # Can't read directory? Fail (assumed single) test.
26 0         0 return do_fail($directory, "Couldn't read directory $directory:$!"); }
27             else {
28 21         842 my @dir_contents = sort readdir($DIR);
29 21         50 my $t;
30 21 100       43 my @core_tests = map { (($t = $_) =~ s/\.tex$// ? ($t) : ()); } @dir_contents;
  631         932  
31 21 100       45 my @daemon_tests = map { (($t = $_) =~ s/\.spec$// ? ($t) : ()); } @dir_contents;
  631         679  
32 21         332 closedir($DIR);
33 21 50   21   10769 if (eval { use_ok("LaTeXML::Core"); }) {
  0         0  
  0         0  
  0         0  
  21         41  
  21         93  
34             SKIP: {
35 0   0     0 my $requires = $options{requires} || {}; # normally a hash: test=>[files...]
  0         0  
36 0 0       0 if (!ref $requires) { # scalar== filename required by ALL
    0          
37 0         0 check_requirements("$directory/", $requires); # may SKIP:
38 0         0 $requires = {}; } # but turn to normal, empty set
39             elsif ($$requires{'*'}) {
40 0         0 check_requirements("$directory/", $$requires{'*'}); }
41              
42 0         0 foreach my $name (@core_tests) {
43 0         0 my $test = "$directory/$name";
44             SKIP: {
45 0 0       0 skip("No file $test.xml", 1) unless (-f "$test.xml");
  0         0  
46 0 0       0 next unless check_requirements($test, $$requires{$name});
47 0         0 latexml_ok("$test.tex", "$test.xml", $test); } }
48 0         0 foreach my $name (@daemon_tests) {
49 0         0 my $test = "$directory/$name";
50             SKIP: {
51 0 0 0     0 skip("No file $test.xml and/or $test.status", 1)
  0         0  
52             unless ((-f "$test.xml") && (-f "$test.status"));
53 0 0       0 next unless check_requirements($test, $$requires{$name});
54 0         0 daemon_ok($test, $directory, $options{generate});
55             } } } }
56             else {
57 21         15936 skip_all("Couldn't load LaTeXML"); } }
58 0           return done_testing(); }
59              
60             sub check_requirements {
61 0     0 0   my ($test, $reqmts) = @_;
62 0 0         foreach my $reqmt (!$reqmts ? () : (ref $reqmts ? @$reqmts : $reqmts)) {
    0          
63 0 0 0       if (($kpsewhich && (`"$kpsewhich" $reqmt`)) || (pathname_find($reqmt))) { }
      0        
64             else {
65 0           my $message = "Missing requirement $reqmt for $test";
66 0           diag("Skip: $message");
67 0           skip($message, 1);
68 0           return 0; } }
69 0           return 1; }
70              
71             sub do_fail {
72 0     0 0   my ($name, $diag) = @_;
73 0           my $ok = ok(0, $name);
74 0           diag($diag);
75 0           return $ok; }
76              
77             # Would like to evolve a sensible XML comparison.
78             # This is a start...
79              
80             # NOTE: This assumes you will have successfully loaded LaTeXML.
81             sub latexml_ok {
82 0     0 0   my ($texpath, $xmlpath, $name) = @_;
83 0 0         if (my $texstrings = process_texfile($texpath, $name)) {
84 0 0         if (my $xmlstrings = process_xmlfile($xmlpath, $name)) {
85 0           return is_strings($texstrings, $xmlstrings, $name); } } }
86              
87             # These return the list-of-strings form of whatever was requested, if successful,
88             # otherwise undef; and they will have reported the failure
89             sub process_texfile {
90 0     0 0   my ($texpath, $name) = @_;
91 0           my $latexml = eval { LaTeXML::Core->new(preload => [], searchpaths => [], includeComments => 0,
  0            
92             verbosity => -2); };
93 0 0         if (!$latexml) {
94 0           do_fail($name, "Couldn't instanciate LaTeXML: " . @!); return; }
  0            
95             else {
96 0           my $dom = eval { $latexml->convertFile($texpath); };
  0            
97 0 0         if (!$dom) {
98 0           do_fail($name, "Couldn't convert $texpath: " . @!); return; }
  0            
99             else {
100 0           return process_dom($dom, $name); } } }
101              
102             sub process_dom {
103 0     0 0   my ($xmldom, $name) = @_;
104             # We want the DOM to be BOTH indented AND canonical!!
105             my $domstring =
106 0           eval { my $string = $xmldom->toString(1);
  0            
107 0           my $parser = XML::LibXML->new(load_ext_dtd=>0, validation=>0, keep_blanks=>1);
108 0           $parser->parse_string($string)->toStringC14N(0); };
109 0 0         if (!$domstring) {
110 0           do_fail($name, "Couldn't convert dom to string: " . $@); return; }
  0            
111             else {
112 0           return process_domstring($domstring, $name); } }
113              
114             sub process_xmlfile {
115 0     0 0   my ($xmlpath, $name) = @_;
116             my $domstring =
117 0           eval { my $parser = XML::LibXML->new(load_ext_dtd=>0, validation=>0, keep_blanks=>1);
  0            
118 0           $parser->parse_file($xmlpath)->toStringC14N(0); };
119 0 0         if (!$domstring) {
120 0           do_fail($name, "Could not convert file $xmlpath to string: " . $@); return; }
  0            
121             else {
122 0           return process_domstring($domstring, $name); } }
123              
124             sub process_domstring {
125 0     0 0   my ($domstring, $name) = @_;
126 0           return [split('\n', $domstring)]; }
127              
128             # This should be OBSOLETE, it has a convoluted, clunky interface
129             sub is_filecontent {
130 0     0 0   my ($strings, $path, $name) = @_;
131             # if(!open(IN,"<:utf8",$path)){
132 0           my $IN;
133 0 0         if (!open($IN, "<", $path)) {
134 0           return do_fail($name, "Could not open $path"); }
135             else {
136 0           my @lines;
137 0           { local $\ = undef;
  0            
138 0           @lines = <$IN>; }
139 0           close($IN);
140 0           return is_strings($strings, [@lines], $name); } }
141              
142             # $strings1 is the currently generated material
143             # $strings2 is the stored expected result.
144             sub is_strings {
145 0     0 0   my ($strings1, $strings2, $name) = @_;
146 0 0         my $max = $#$strings1 > $#$strings2 ? $#$strings1 : $#$strings2;
147 0           my $ok = 1;
148 0           for (my $i = 0 ; $i <= $max ; $i++) {
149 0           my $string1 = $$strings1[$i];
150 0           my $string2 = $$strings2[$i];
151 0 0         if (defined $string1) {
152 0           chomp($string1); }
153             else {
154 0           $ok = 0; $string1 = ""; }
  0            
155 0 0         if (defined $string2) {
156 0           chomp($string2); }
157             else {
158 0           $ok = 0; $string2 = ""; }
  0            
159 0 0 0       if (!$ok || ($string1 ne $string2)) {
160 0           return do_fail($name,
161             "Difference at line " . ($i + 1) . " for $name\n"
162             . " got : '$string1'\n"
163             . " expected : '$string2'\n"); } }
164 0           return ok(1, $name); }
165              
166             sub daemon_ok {
167 0     0 0   my ($base, $dir, $generate) = @_;
168 0           my $current_dir = pathname_cwd();
169 0           my $localname = $base;
170 0           $localname =~ s/$dir\///;
171 0           my $opts = read_options("$base.spec", $base);
172 0           push @$opts, (['destination', "$localname.test.xml"],
173             ['log', "/dev/null"],
174             ['timeout', 10],
175             ['autoflush', 1],
176             ['timestamp', '0'],
177             ['nodefaultresources', ''],
178             ['xsltparameter', 'LATEXML_VERSION:TEST'],
179             ['nocomments', '']);
180              
181 0           my $invocation = catfile($FindBin::Bin, '..', 'blib', 'script', 'latexmlc') . ' ';
182 0           my $timed = undef;
183 0           foreach my $opt (@$opts) {
184 0 0         if ($$opt[0] eq 'timeout') { # Ensure .opt timeout takes precedence
185 0 0         if ($timed) { next; } else { $timed = 1; }
  0            
  0            
186             }
187 0 0         $invocation .= "--" . $$opt[0] . (length($$opt[1]) ? ('="' . $$opt[1] . '" ') : (' '));
188             }
189 0           $invocation .= " 2>$localname.test.status ";
190 0 0         if (!$generate) {
191 0           chdir($dir);
192 0           is(system($invocation), 0, "latexmlc invocation for test $localname");
193 0           chdir($current_dir);
194             # Compare the just generated $base.test.xml to the previous $base.xml
195 0 0         if (my $teststrings = process_xmlfile("$base.test.xml", $base)) {
196 0 0         if (my $xmlstrings = process_xmlfile("$base.xml", $base)) {
197 0           is_strings($teststrings, $xmlstrings, $base); } }
198              
199             # Compare the just generated $base.test.status to the previous $base.status
200 0 0         if (my $teststatus = get_filecontent("$base.test.status", $base)) {
201 0 0         if (my $status = get_filecontent("$base.status", $base)) {
202 0           is_strings($teststatus, $status, $base); } }
203 0 0         unlink "$base.test.xml" if -e "$base.test.xml";
204 0 0         unlink "$base.test.status" if -e "$base.test.status";
205             }
206             else {
207             #TODO: Skip 3 tests
208 0           print STDERR "$invocation\n";
209 0           chdir($dir);
210 0           system($invocation);
211 0           chdir($current_dir);
212 0 0         move("$base.test.xml", "$base.xml") if -e "$base.test.xml";
213 0 0         move("$base.test.status", "$base.status") if -e "$base.test.status";
214             }
215 0           return; }
216              
217             sub read_options {
218 0     0 0   my ($optionfile, $testname) = @_;
219 0           my $opts = [];
220 0           my $OPT;
221 0 0         if (open($OPT, "<", $optionfile)) {
222 0           while (my $line = <$OPT>) {
223 0 0         next if $line =~ /^#/;
224 0           chomp($line);
225 0 0         if ($line =~ /(\S+)\s*=\s*(.*)/) {
226 0   0       my ($key, $value) = ($1, $2 || '');
227 0           $value =~ s/\s+$//;
228 0           push @$opts, [$key, $value]; } }
229 0           close $OPT; }
230             else {
231 0           do_fail($testname, "Could not open $optionfile"); }
232 0           return $opts; }
233              
234             sub get_filecontent {
235 0     0 0   my ($path, $testname) = @_;
236 0           my $IN;
237             my @lines;
238 0 0         if (-e $path) {
239 0 0         if (!open($IN, "<", $path)) {
240 0           do_fail($testname, "Could not open $path"); }
241             else {
242 0           { local $\ = undef;
  0            
243 0           @lines = <$IN>; }
244 0           close($IN);
245             }
246             }
247 0 0         if (scalar(@lines)) {
248 0           $lines[-1] =~ s/\s+$//;
249             } else {
250 0           push @lines, '';
251             }
252 0           return \@lines; }
253              
254             # TODO: Reconsider what else we need to test, ideas below:
255              
256             # Tier 1.3: Math setups with embedding variations
257              
258             # Tier 1.5:
259              
260             # Tier 2: Preloads and preambles
261              
262             # Tier 3: Autoflush and Timeouts
263              
264             # Tier 4: Ports and local conversion
265              
266             # Tier 5: Defaults and multi-job daemon processing
267              
268             # 1. We need to test daemon in fragment mode with fragment tests, math mode with math tests and standard mode with standard tests. Essentially, this is all about having the right preambles.
269              
270             # 2. We need to benchmark consecutive runs, to make sure the first run is slowest and the rest (3?5?) are not initializing.
271              
272             # 2.1. Set a --autoflush to 2 , send 3 conversions and make sure the process pid's differ.
273              
274             # 2.2. Make sure an infinite macro times out (set --timeout=3 for fast test)
275             # 2.3. Check if the server can be set up on all default ports.
276              
277             # 3. Exhaustively test all possible option combinations - we need triples of option vector with a test case and XML result, or some sane setup of this nature.
278              
279             # 4. Moreover, we should test the option logic by comparing input-output option hashes (again, exhaustively!)
280              
281             # 5. We need to compare the final document, log and summary produced.
282              
283             1;