tap-driver

Show log
Commit

Hash : 0c81b43f
Author :
Date : 2011-07-28T12:25:22

test harness: use new `.trs' files to hold test metadata

With this change, the test harness will keep test metadata in
dedicated `.trs' files, instead of having them embedded into the
`.log' files.  This allows for easier forward-compatibility and
extension of test metadata, and for more flexibility in the
format of the `.log' files.  Note that this change makes the
`:end-metadata:' field obsolete.

* doc/automake.texi (Parallel Test Harness, Log files generation
and test results recording): Document the new APIs and behaviour;
some related minor rewordings and fixlets.
* NEWS: Update.
* automake.in (handle_tests): When bringing in the content of
`check2.am', substitute %BASE% with the basename of the `.log'
file being created by a rule.  Add the generated `.trs' files
to the list of files to be cleaned by "make mostlyclean".
* lib/am/check.am (am__test_driver_flags): Rename ...
(am__common_driver_flags): ... to this, and remove the flags
`--test-name' and `--log-file' from it: they are now define in
the proper rules in `check2.am'.
(am__TEST_BASES): New internal variable, holding the names of
the tests, with any registered extension removed.
(am__stealth_MAKE): New internal variable, can be used instead of
$(MAKE) in recipes requiring a recursive call to make, but which
are not intended to be executed by "make -n".
(.log.trs): New suffix rule, to recover from deletion of `.trs'
files.
($(TEST_SUITE_LOG)): Almost completely rewritten to follow the
new API of "test logs in `.log' files, test metadata in `.trs'
files".  It goes to some length to work correctly in face of
unreadable or missing `.log' and `.trs' files, and to error out
with proper error messages when this is not possible.
[%?PARALLEL_TESTS%] (check-TESTS): Also remove relevant "stale"
`.trs' files (in addition to `.log files) before remaking the
$(TEST_SUITE_LOG).
(recheck, recheck-html): Look for the `:recheck:' field in the
`.trs' files, not in the `.log' files.
* lib/am/check2.am (?GENERIC?%EXT%.log, ?!GENERIC?%OBJ%): Adjust
the call to the test driver, in particularly passing the new
option `--trs-file'.
[%am__EXEEXT%] (?GENERIC?%EXT%$(EXEEXT).log): Likewise.
* lib/tap-driver ($USAGE): Adjust the help screen.
(Getopt::Long::GetOptions): Handle the `--trs-file' option,
through the use of ...
($trs_file): ... this new global variable.
(finish): Write metadata for the test run to `$trs_file' rather
then to `$log_file', through the use of ...
(write_test_results): ... this new function.
* lib/test-driver (print_usage): Update the help screen.
(Option parsing): Handle the `--trs-file' option, through the
use of ...
($resfile): ... this new global variable.
(Main code): Write metadata for the test run to `$trsfile' rather
than to `$logfile'.
Minor related adjustments to comments.
* tests/.gitignore: Ignore `*.trs' files.
* tests/parallel-tests-unreadable-log.test: Moved ...
* tests/parallel-tests-unreadable.test: ... to this, and extended
to also check the semantics for unreadable `.trs' files.
* tests/test-driver-end-metadata.test: Deleted as obsolete.
* tests/test-driver-metadata-no-leading-space.test: Likewise.
* tests/test-driver-global-log.test: Renamed ...
* tests/test-metadata-global-log.test: ... to this, and modified
as to verify the new APIs and semantics.
* tests/test-driver-recheck: Renamed ...
* tests/test-metadata-recheck.test: ... to this, and modified
likewise.
* tests/parallel-tests-once.test: New test.
* tests/parallel-tests-make-n.test: Likewise.
* test-metadata-results.test: Likewise.
* test-missing.test: Likewise.
* test-missing2.test: Likewise.
* test-trs-basic.test: Likewise.
* test-trs-recover.test: Likewise.
* test-trs-recover2.test: Likewise.
* tests/Makefile.am (TESTS): Update.

Download

lib/tap-driver

#! /usr/bin/env perl
# Temporary/experimental TAP test driver for Automake.
# TODO: should be rewritten portably (e.g., in awk or shell).

# ---------------------------------- #
#  Imports, static data, and setup.  #
# ---------------------------------- #

use warnings FATAL => 'all';
use strict;
use Getopt::Long ();
use TAP::Parser;

my $ME = "tap-driver";

my $USAGE = <<'END';
Usage:
  tap-driver --test-name=NAME --log-file=PATH --trs-file=PATH
             [--expect-failure={yes|no}] [--color-tests={yes|no}]
             [--enable-hard-errors={yes|no}] [--merge|--no-merge]
             [--ignore-exit] [--comments|--no-comments] [--] TEST-COMMAND
The `--test-name' and `--log-file' options are mandatory.
END

my $HELP = "$ME: TAP-aware test driver for Automake testsuite harness." .
           "\n" . $USAGE;

my $VERSION = '(experimental version)';

# Keep this in sync with `lib/am/check.am:$(am__tty_colors)'.
my %COLOR = (
  red => "\e[0;31m",
  grn => "\e[0;32m",
  lgn => "\e[1;32m",
  blu => "\e[1;34m",
  mgn => "\e[0;35m",
  brg => "\e[1m",
  std => "\e[m",
);

# ------------------- #
#  Global variables.  #
# ------------------- #

my $lineno = 0;     # Number of input lines seen so far.
my $testno = 0;     # Number of test results seen so far.
my $plan_seen = 0;  # Whether the TAP plan has been seen or not.
my $parser;         # TAP parser object (will be initialized later).

# ----------------- #
#  Option parsing.  #
# ----------------- #

my %cfg = (
  "color-tests" => 0,
  "expect-failure" => 0,
  "enable-hard-errors" => 1,
  "merge" => 0,
  "comments" => 0,
  "ignore-exit" => 0,
);

my $test_script_name = undef;
my $log_file = undef;
my $trs_file = undef;

Getopt::Long::GetOptions (
    'help' => sub { print $HELP; exit 0; },
    'version' => sub { print "$ME $VERSION"; exit 0; },
    'test-name=s' => \$test_script_name,
    'log-file=s' => \$log_file,
    'res-file=s' => \$trs_file,
    'color-tests=s'  => \&bool_opt,
    'expect-failure=s'  => \&bool_opt,
    'enable-hard-errors=s' => \&bool_opt,
    'comments' => sub { $cfg{"comments"} = 1; },
    'no-comments' => sub { $cfg{"comments"} = 0; },
    'merge' => sub { $cfg{"merge"} = 1; },
    'no-merge' => sub { $cfg{"merge"} = 0; },
    'ignore-exit' => sub { $cfg{"ignore-exit"} = 1; },
  ) or exit 1;

# -------------- #
#  Subroutines.  #
# -------------- #

sub bool_opt ($$)
{
  my ($opt, $val) = @_;
  if ($val =~ /^(?:y|yes)\z/i)
    {
      $cfg{$opt} = 1;
    }
  elsif ($val =~ /^(?:n|no)\z/i)
    {
      $cfg{$opt} = 0;
    }
  else
    {
      die "invalid argument '$val' for option '$opt'\n";
    }
}

TAP_PEEKING :
{
  my @tap_lines = ();

  sub get_tap_line ()
  {
    @tap_lines > 0 ? pop @tap_lines : $parser->next;
  }

  sub unget_tap_line ($)
  {
    push @tap_lines, @_;
  }

  sub peek_tap_line ()
  {
    my $res = get_tap_line;
    unget_tap_line ($res);
    return $res;
  }

}

TEST_RESULTS :
{
  my (@test_results, %test_results);

  sub add_test_result ($)
  {
    my $res = shift;
    push @test_results, $res;
    $test_results{$res} = 1;
  }

  sub get_test_results ()
  {
    return @test_results;
  }

  # Whether the test script should be re-run by "make recheck".
  sub must_recheck ()
  {
    return grep { !/^(?:XFAIL|PASS|SKIP)$/ } (keys %test_results);
  }

  # Whether the content of the log file associated to this test should
  # be copied into the "global" test-suite.log.
  sub copy_in_global_log ()
  {
    return grep { not $_ eq "PASS" } (keys %test_results);
  }

  # FIXME: this can certainly be improved ...
  sub get_global_test_result ()
  {
    my @results = keys %test_results;
    return "ERROR" if exists $test_results{"ERROR"};
    return "SKIP" if @results == 1 && $results[0] eq "SKIP";
    return "FAIL" if exists $test_results{"FAIL"};
    return "FAIL" if exists $test_results{"XPASS"};
    return "PASS";
  }

}

sub write_test_results ()
{
  open RES, ">", $trs_file or die "opening $trs_file: $!\n";
  print RES ":recheck: " .
            (must_recheck ? "yes" : "no") . "\n";
  print RES ":copy-in-global-log: " .
            (copy_in_global_log ? "yes" : "no") . "\n";
  foreach my $result (get_test_results)
    {
      print RES ":test-result: $result\n";
    }
  close RES or die "closing $trs_file: $!\n";
}

sub start (@)
{
  # Redirect stderr and stdout to a temporary log file.  Save the
  # original stdout stream, since we need it to print testsuite
  # progress output.
  open OLDOUT, ">&STDOUT" or die "duplicating stdout: $!\n";
  open TMP, ">$log_file-t" or die "opening $log_file-t: $!\n";
  open STDOUT, ">&TMP" or die "redirecting stdout: $!\n";
  open STDERR, ">&TMP" or die "redirecting stderr: $!\n";
  $parser = TAP::Parser->new ({ exec => \@_, merge => $cfg{merge} });
  $parser->ignore_exit(1) if $cfg{"ignore-exit"};
}

sub finish ()
{
  write_test_results;

  open LOG, ">", $log_file or die "opening $log_file: $!\n";
  my $global_result = get_global_test_result;
  my $global_result_line = "$global_result: $test_script_name";
  print LOG "$global_result_line\n";
  print LOG "=" x length ($global_result_line) . "\n";
  print LOG "\n";

  close TMP or die "closing $log_file-t: $!\n";
  # FIXME: remove this hack!
  my $test_output = `cat $log_file-t && rm -f $log_file-t`;
  print LOG $test_output;
  close LOG or die "closing $log_file: $!\n";

  exit 0;
}

sub stringify_test_result ($)
{
  my $result = shift;
  my $PASS = $cfg{"expect-failure"} ? "XPASS": "PASS";
  my $FAIL = $cfg{"expect-failure"} ? "XFAIL": "FAIL";
  if ($result->is_unplanned || $result->number != $testno)
    {
      return "ERROR";
    }
  elsif (!$result->directive)
    {
      return $result->is_ok ? $PASS: $FAIL;
    }
  elsif ($result->has_todo)
    {
      return $result->is_actual_ok ? "XPASS" : "XFAIL";
    }
  elsif ($result->has_skip)
    {
      return $result->is_ok ? "SKIP" : $FAIL;
    }
  die "INTERNAL ERROR"; # NOTREACHED
}

sub colored ($$)
{
  my ($color_name, $text) = @_;
  return  $COLOR{$color_name} . $text . $COLOR{'std'};
}

sub decorate_result ($)
{
  my $result = shift;
  return $result unless $cfg{"color-tests"};
  my %color_for_result =
    (
      "ERROR" => 'mgn',
      "PASS"  => 'grn',
      "XPASS" => 'red',
      "FAIL"  => 'red',
      "XFAIL" => 'lgn',
      "SKIP"  => 'blu',
    );
  if (my $color = $color_for_result{$result})
    {
      return colored ($color, $result);
    }
  else
    {
      return $result; # Don't colorize unknown stuff.
    }
}

sub report ($;$)
{
  my ($msg, $result, $explanation) = (undef, @_);
  if ($result =~ /^(?:X?(?:PASS|FAIL)|SKIP|ERROR)/)
    {
      $msg = ": $test_script_name";
      add_test_result $result;
    }
  elsif ($result eq "#")
    {
      $msg = " $test_script_name:";
    }
  else
    {
      die "INTERNAL ERROR"; # NOTREACHED
    }
  $msg .= " $explanation" if defined $explanation;
  $msg .= "\n";
  # Output on console might be colorized.
  print OLDOUT decorate_result ($result) . $msg;
  # Log the result in the log file too, to help debugging (this is
  # especially true when said result is a TAP error or "Bail out!").
  print $result . $msg;
}

sub testuite_error ($)
{
  report "ERROR", "- $_[0]";
}

sub handle_tap_test ($)
{
  $testno++;
  my $test = shift;

  my $test_result = stringify_test_result $test;
  my $string = $test->number;
  
  if (my $description = $test->description)
    {
      $string .= " $description";
    }
  if ($test->is_unplanned)
    {
      $string .= " # UNPLANNED";
    }
  elsif ($test->number != $testno)
    {
      $string .= " # OUT-OF-ORDER (expecting $testno)";
    }
  elsif (my $directive = $test->directive)
    {
      $string .= " # $directive";
      if (my $explanation = $test->explanation)
        {
          $string .= " $explanation";
        }
    }
  report $test_result, $string;
}

sub handle_tap_plan ($)
{
  my $plan = shift;
  testuite_error "multiple test plans" if $plan_seen;
  $plan_seen = 1;
  # TAP plan must be either in the first or in the last line.
  if ($lineno > 1 && peek_tap_line)
    {
      testuite_error "test plan in middle of output";
      return;
    }
  # Nothing more to do, unless the plan contains a SKIP directive.
  return
    if not defined $plan->directive && length ($plan->directive) > 0;
  my $explanation = $plan->explanation ?
                    "- " . $plan->explanation : undef;
  report "SKIP", $explanation;
  finish;
}

sub handle_tap_bailout ($)
{
  my ($bailout, $msg) = ($_[0], "Bail out!");
  $msg .= " " . $bailout->explanation if $bailout->explanation;
  testuite_error $msg;
  finish;
}

sub handle_tap_comment ($)
{
  return unless $cfg{comments};
  my $comment = $_[0]->comment;
  report "#", "$comment" if length $comment;
}

sub main (@)
{
  start @_;

  while (defined (my $cur = get_tap_line))
    {
      # Verbatim copy any input line into the log file.
      print $cur->raw . "\n";
      $lineno++;
      if ($cur->is_plan)
        {
          handle_tap_plan ($cur);
        }
      elsif ($cur->is_test)
        {
          handle_tap_test ($cur);
        }
      elsif ($cur->is_comment)
        {
          handle_tap_comment ($cur);
        }
      elsif ($cur->is_bailout)
        {
          handle_tap_bailout ($cur);
        }
    }
  if (!$plan_seen)
    {
      testuite_error "missing test plan";
    }
  elsif ($parser->tests_planned != $parser->tests_run)
    {
      my ($planned, $run) = ($parser->tests_planned, $parser->tests_run);
      my $bad_amount = $run > $planned ? "many" : "few";
      testuite_error (sprintf "too %s tests run (expected %d, got %d)",
                              $bad_amount, $planned, $run);
    }
  # TODO: we should probably use $parser->wait here, to catch signals too
  if ($parser->exit != 0)
  {
    my $msg = sprintf "exited with status %d", $parser->exit;
    if ($cfg{"ignore-exit"})
      {
        # Log the exit status of the script anyway, even if it is not
        # considered to be an error, to help debugging.
        print "INFO: $test_script_name - $msg\n";
      }
    else
      {
        testuite_error $msg;;
      }
  }
  finish;
}

# ----------- #
#  Main code. #
# ----------- #

main @ARGV;

# vim: ft=perl ts=4 sw=4 et

Download

kc3-lang/automake/lib/tap-driver

Commit

lib/tap-driver