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

package LaTeXML::Util::Test;
use strict;
use warnings;

use Test::More;
use LaTeXML::Util::Pathname;
use JSON::XS;
use FindBin;
use File::Copy;
use File::Which;
use File::Spec::Functions;
use base qw(Exporter);
#  @Test::More::EXPORT);
our @EXPORT = (qw(&latexml_ok &latexml_tests),
  @Test::More::EXPORT);
my $kpsewhich = which($ENV{LATEXML_KPSEWHICH} || 'kpsewhich');    # [CONFIGURATION]
# Note that this is a singlet; the same Builder is shared.

# Test the conversion of all *.tex files in the given directory (typically t/something)
# Skip any that have no corresponding *.xml file.
sub latexml_tests {
  my ($directory, %options) = @_;
  my $DIR;
  if (!opendir($DIR, $directory)) {
    # Can't read directory? Fail (assumed single) test.
    return do_fail($directory, "Couldn't read directory $directory:$!"); }
  else {
    my @dir_contents = sort readdir($DIR);
    my $t;
    my @core_tests   = map { (($t = $_) =~ s/\.tex$//  ? ($t) : ()); } @dir_contents;
    my @daemon_tests = map { (($t = $_) =~ s/\.spec$// ? ($t) : ()); } @dir_contents;
    closedir($DIR);
    if (eval { use_ok("LaTeXML::Core"); }) {
    SKIP: {
        my $requires = $options{requires} || {};    # normally a hash: test=>[files...]
        if (!ref $requires) {                       # scalar== filename required by ALL
          check_requirements("$directory/", $requires);    # may SKIP:
          $requires = {}; }                                # but turn to normal, empty set
        elsif ($$requires{'*'}) {
          check_requirements("$directory/", $$requires{'*'}); }

        foreach my $name (@core_tests) {
          my $test = "$directory/$name";
        SKIP: {
            skip("No file $test.xml", 1) unless (-f "$test.xml");
            next unless check_requirements($test, $$requires{$name});
            latexml_ok("$test.tex", "$test.xml", $test); } }
        foreach my $name (@daemon_tests) {
          my $test = "$directory/$name";
        SKIP: {
            skip("No file $test.xml and/or $test.status", 1)
              unless ((-f "$test.xml") && (-f "$test.status"));
            next unless check_requirements($test, $$requires{$name});
            daemon_ok($test, $directory, $options{generate});
          } } } }
    else {
      skip_all("Couldn't load LaTeXML"); } }
  return done_testing(); }

sub check_requirements {
  my ($test, $reqmts) = @_;
  foreach my $reqmt (!$reqmts ? () : (ref $reqmts ? @$reqmts : $reqmts)) {
    if (($kpsewhich && (`"$kpsewhich" $reqmt`)) || (pathname_find($reqmt))) { }
    else {
      my $message = "Missing requirement $reqmt for $test";
      diag("Skip: $message");
      skip($message, 1);
      return 0; } }
  return 1; }

sub do_fail {
  my ($name, $diag) = @_;
  my $ok = ok(0, $name);
  diag($diag);
  return $ok; }

# Would like to evolve a sensible XML comparison.
# This is a start...

# NOTE: This assumes you will have successfully loaded LaTeXML.
sub latexml_ok {
  my ($texpath, $xmlpath, $name) = @_;
  if (my $texstrings = process_texfile($texpath, $name)) {
    if (my $xmlstrings = process_xmlfile($xmlpath, $name)) {
      return is_strings($texstrings, $xmlstrings, $name); } } }

# These return the list-of-strings form of whatever was requested, if successful,
# otherwise undef; and they will have reported the failure
sub process_texfile {
  my ($texpath, $name) = @_;
  my $latexml = eval { LaTeXML::Core->new(preload => [], searchpaths => [], includeComments => 0,
      verbosity => -2); };
  if (!$latexml) {
    do_fail($name, "Couldn't instanciate LaTeXML: " . @!); return; }
  else {
    my $dom = eval { $latexml->convertFile($texpath); };
    if (!$dom) {
      do_fail($name, "Couldn't convert $texpath: " . @!); return; }
    else {
      return process_dom($dom, $name); } } }

sub process_dom {
  my ($xmldom, $name) = @_;
  # We want the DOM to be BOTH indented AND canonical!!
  my $domstring =
    eval { my $string = $xmldom->toString(1);
    my $parser = XML::LibXML->new(load_ext_dtd=>0, validation=>0, keep_blanks=>1);
    $parser->parse_string($string)->toStringC14N(0); };
  if (!$domstring) {
    do_fail($name, "Couldn't convert dom to string: " . $@); return; }
  else {
    return process_domstring($domstring, $name); } }

sub process_xmlfile {
  my ($xmlpath, $name) = @_;
  my $domstring =
    eval { my $parser = XML::LibXML->new(load_ext_dtd=>0, validation=>0, keep_blanks=>1);
    $parser->parse_file($xmlpath)->toStringC14N(0); };
  if (!$domstring) {
    do_fail($name, "Could not convert file $xmlpath to string: " . $@); return; }
  else {
    return process_domstring($domstring, $name); } }

sub process_domstring {
  my ($domstring, $name) = @_;
  return [split('\n', $domstring)]; }

# This should be OBSOLETE, it has a convoluted, clunky interface
sub is_filecontent {
  my ($strings, $path, $name) = @_;
  #  if(!open(IN,"<:utf8",$path)){
  my $IN;
  if (!open($IN, "<", $path)) {
    return do_fail($name, "Could not open $path"); }
  else {
    my @lines;
    { local $\ = undef;
      @lines = <$IN>; }
    close($IN);
    return is_strings($strings, [@lines], $name); } }

# $strings1 is the currently generated material
# $strings2 is the stored expected result.
sub is_strings {
  my ($strings1, $strings2, $name) = @_;
  my $max = $#$strings1 > $#$strings2 ? $#$strings1 : $#$strings2;
  my $ok = 1;
  for (my $i = 0 ; $i <= $max ; $i++) {
    my $string1 = $$strings1[$i];
    my $string2 = $$strings2[$i];
    if (defined $string1) {
      chomp($string1); }
    else {
      $ok = 0; $string1 = ""; }
    if (defined $string2) {
      chomp($string2); }
    else {
      $ok = 0; $string2 = ""; }
    if (!$ok || ($string1 ne $string2)) {
      return do_fail($name,
        "Difference at line " . ($i + 1) . " for $name\n"
          . "      got : '$string1'\n"
          . " expected : '$string2'\n"); } }
  return ok(1, $name); }

sub daemon_ok {
  my ($base, $dir, $generate) = @_;
  my $current_dir = pathname_cwd();
  my $localname   = $base;
  $localname =~ s/$dir\///;
  my $opts = read_options("$base.spec", $base);
  push @$opts, (['destination', "$localname.test.xml"],
    ['log',                "/dev/null"],
    ['timeout',            10],
    ['autoflush',          1],
    ['timestamp',          '0'],
    ['nodefaultresources', ''],
    ['xsltparameter',      'LATEXML_VERSION:TEST'],
    ['nocomments',         '']);

  my $invocation = catfile($FindBin::Bin, '..', 'blib', 'script', 'latexmlc') . ' ';
  my $timed = undef;
  foreach my $opt (@$opts) {
    if ($$opt[0] eq 'timeout') {    # Ensure .opt timeout takes precedence
      if ($timed) { next; } else { $timed = 1; }
    }
    $invocation .= "--" . $$opt[0] . (length($$opt[1]) ? ('="' . $$opt[1] . '" ') : (' '));
  }
  $invocation .= " 2>$localname.test.status ";
  if (!$generate) {
    chdir($dir);
    is(system($invocation), 0, "latexmlc invocation for test $localname");
    chdir($current_dir);
    # Compare the just generated $base.test.xml to the previous $base.xml
    if (my $teststrings = process_xmlfile("$base.test.xml", $base)) {
      if (my $xmlstrings = process_xmlfile("$base.xml", $base)) {
        is_strings($teststrings, $xmlstrings, $base); } }

    # Compare the just generated $base.test.status to the previous $base.status
    if (my $teststatus = get_filecontent("$base.test.status", $base)) {
      if (my $status = get_filecontent("$base.status", $base)) {
        is_strings($teststatus, $status, $base); } }
    unlink "$base.test.xml"    if -e "$base.test.xml";
    unlink "$base.test.status" if -e "$base.test.status";
  }
  else {
    #TODO: Skip 3 tests
    print STDERR "$invocation\n";
    chdir($dir);
    system($invocation);
    chdir($current_dir);
    move("$base.test.xml",    "$base.xml")    if -e "$base.test.xml";
    move("$base.test.status", "$base.status") if -e "$base.test.status";
  }
  return; }

sub read_options {
  my ($optionfile, $testname) = @_;
  my $opts = [];
  my $OPT;
  if (open($OPT, "<", $optionfile)) {
    while (my $line = <$OPT>) {
      next if $line =~ /^#/;
      chomp($line);
      if ($line =~ /(\S+)\s*=\s*(.*)/) {
        my ($key, $value) = ($1, $2 || '');
        $value =~ s/\s+$//;
        push @$opts, [$key, $value]; } }
    close $OPT; }
  else {
    do_fail($testname, "Could not open $optionfile"); }
  return $opts; }

sub get_filecontent {
  my ($path, $testname) = @_;
  my $IN;
  my @lines;
  if (-e $path) {
    if (!open($IN, "<", $path)) {
      do_fail($testname, "Could not open $path"); }
    else {
      { local $\ = undef;
        @lines = <$IN>; }
      close($IN);
    }
  }
  if (scalar(@lines)) {
    $lines[-1] =~ s/\s+$//;
  } else {
    push @lines, '';
  }
  return \@lines; }

# TODO: Reconsider what else we need to test, ideas below:

# Tier 1.3: Math setups with embedding variations

# Tier 1.5:

# Tier 2: Preloads and preambles

# Tier 3: Autoflush and Timeouts

# Tier 4: Ports and local conversion

# Tier 5: Defaults and multi-job daemon processing

# 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.

# 2. We need to benchmark consecutive runs, to make sure the first run is slowest and the rest (3?5?) are not initializing.

# 2.1. Set a --autoflush to 2 , send 3 conversions and make sure the process pid's differ.

# 2.2. Make sure an infinite macro times out (set --timeout=3 for fast test)
# 2.3. Check if the server can be set up on all default ports.

# 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.

# 4. Moreover, we should test the option logic by comparing input-output option hashes (again, exhaustively!)

# 5. We need to compare the final document, log and summary produced.

1;