# Third-party, obsolescent or experimental stuff.
EXTRA_DIST += \
+ contrib/tap-driver.pl \
contrib/check-html.am \
contrib/multilib/README \
contrib/multilib/config-ml.in \
(3) the "set -f" and "set +f" shell commands work, and, respectively,
disable and enable shell globbing.
+* Automake-generated testsuite:
+
+ - The perl implementation of the TAP testsuite driver is no longer
+ installed in the Automake's scripts directory, and is instead just
+ distributed as a "contrib" addition. There should be no reason to
+ use this implementation anyway in real packages, since the awk+shell
+ implementation of the TAP driver (that is documented in the manual)
+ is more portable and has feature parity with the perl implementation.
+
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
New in 1.14.1:
--- /dev/null
+#! /usr/bin/env perl
+# Copyright (C) 2011-2013 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 2, 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 <http://www.gnu.org/licenses/>.
+
+# As a special exception to the GNU General Public License, if you
+# distribute this file as part of a program that contains a
+# configuration script generated by Autoconf, you may include it under
+# the same distribution terms that you use for the rest of that program.
+
+# This file is maintained in Automake, please report
+# bugs to <bug-automake@gnu.org> or send patches to
+# <automake-patches@gnu.org>.
+
+# ---------------------------------- #
+# Imports, static data, and setup. #
+# ---------------------------------- #
+
+use warnings FATAL => 'all';
+use strict;
+use Getopt::Long ();
+use TAP::Parser;
+
+my $VERSION = '2013-12-24.15'; # UTC
+
+my $ME = "tap-driver.pl";
+
+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}] [--ignore-exit]
+ [--diagnostic-string=STRING] [--merge|--no-merge]
+ [--comments|--no-comments] [--] TEST-COMMAND
+The '--test-name', '--log-file' and '--trs-file' options are mandatory.
+END
+
+my $HELP = "$ME: TAP-aware test driver for Automake testsuite harness." .
+ "\n" . $USAGE;
+
+# 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",
+);
+
+# It's important that NO_PLAN evaluates "false" as a boolean.
+use constant NO_PLAN => 0;
+use constant EARLY_PLAN => 1;
+use constant LATE_PLAN => 2;
+
+# ------------------- #
+# Global variables. #
+# ------------------- #
+
+my $testno = 0; # Number of test results seen so far.
+my $bailed_out = 0; # Whether a "Bail out!" directive has been seen.
+my $parser; # TAP parser object (will be initialized later).
+
+# Whether the TAP plan has been seen or not, and if yes, which kind
+# it is ("early" is seen before any test result, "late" otherwise).
+my $plan_seen = NO_PLAN;
+
+# ----------------- #
+# Option parsing. #
+# ----------------- #
+
+my %cfg = (
+ "color-tests" => 0,
+ "expect-failure" => 0,
+ "merge" => 0,
+ "comments" => 0,
+ "ignore-exit" => 0,
+);
+
+my $test_script_name = undef;
+my $log_file = undef;
+my $trs_file = undef;
+my $diag_string = "#";
+
+Getopt::Long::GetOptions
+ (
+ 'help' => sub { print $HELP; exit 0; },
+ 'version' => sub { print "$ME $VERSION\n"; exit 0; },
+ 'test-name=s' => \$test_script_name,
+ 'log-file=s' => \$log_file,
+ 'trs-file=s' => \$trs_file,
+ 'color-tests=s' => \&bool_opt,
+ 'expect-failure=s' => \&bool_opt,
+ 'enable-hard-errors=s' => sub {}, # No-op.
+ 'diagnostic-string=s' => \$diag_string,
+ '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;
+
+# ------------- #
+# Prototypes. #
+# ------------- #
+
+sub add_test_result ($);
+sub bool_opt ($$);
+sub colored ($$);
+sub copy_in_global_log ();
+sub decorate_result ($);
+sub extract_tap_comment ($);
+sub finish ();
+sub get_global_test_result ();
+sub get_test_exit_message ();
+sub get_test_results ();
+sub handle_tap_bailout ($);
+sub handle_tap_plan ($);
+sub handle_tap_result ($);
+sub is_null_string ($);
+sub main (@);
+sub must_recheck ();
+sub report ($;$);
+sub setup_io ();
+sub setup_parser (@);
+sub stringify_result_obj ($);
+sub testsuite_error ($);
+sub trap_perl_warnings_and_errors ();
+sub write_test_results ();
+sub yn ($);
+
+# -------------- #
+# 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 "$ME: invalid argument '$val' for option '$opt'\n";
+ }
+}
+
+# If the given string is undefined or empty, return true, otherwise
+# return false. This function is useful to avoid pitfalls like:
+# if ($message) { print "$message\n"; }
+# which wouldn't print anything if $message is the literal "0".
+sub is_null_string ($)
+{
+ my $str = shift;
+ return ! (defined $str and length $str);
+}
+
+# Convert a boolean to a "yes"/"no" string.
+sub yn ($)
+{
+ my $bool = shift;
+ return $bool ? "yes" : "no";
+}
+
+TEST_RESULTS :
+{
+ my (@test_results_list, %test_results_seen);
+
+ sub add_test_result ($)
+ {
+ my $res = shift;
+ push @test_results_list, $res;
+ $test_results_seen{$res} = 1;
+ }
+
+ sub get_test_results ()
+ {
+ return @test_results_list;
+ }
+
+ # Whether the test script should be re-run by "make recheck".
+ sub must_recheck ()
+ {
+ return grep { !/^(?:XFAIL|PASS|SKIP)$/ } (keys %test_results_seen);
+ }
+
+ # 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_seen);
+ }
+
+ sub get_global_test_result ()
+ {
+ return "ERROR"
+ if $test_results_seen{"ERROR"};
+ return "FAIL"
+ if $test_results_seen{"FAIL"} || $test_results_seen{"XPASS"};
+ return "SKIP"
+ if scalar keys %test_results_seen == 1 && $test_results_seen{"SKIP"};
+ return "PASS";
+ }
+
+}
+
+sub write_test_results ()
+{
+ open RES, ">", $trs_file or die "$ME: opening $trs_file: $!\n";
+ print RES ":global-test-result: " . get_global_test_result . "\n";
+ print RES ":recheck: " . yn (must_recheck) . "\n";
+ print RES ":copy-in-global-log: " . yn (copy_in_global_log) . "\n";
+ foreach my $result (get_test_results)
+ {
+ print RES ":test-result: $result\n";
+ }
+ close RES or die "$ME: closing $trs_file: $!\n";
+}
+
+sub trap_perl_warnings_and_errors ()
+{
+ $SIG{__WARN__} = $SIG{__DIE__} = sub
+ {
+ # Be sure to send the warning/error message to the original stderr
+ # (presumably the console), not into the log file.
+ open STDERR, ">&OLDERR";
+ die @_;
+ }
+}
+
+sub setup_io ()
+{
+ # Redirect stderr and stdout to a temporary log file. Save the
+ # original stdout stream, since we need it to print testsuite
+ # progress output. Save original stderr stream, so that we can
+ # redirect warning and error messages from perl there.
+ open LOG, ">", $log_file or die "$ME: opening $log_file: $!\n";
+ open OLDOUT, ">&STDOUT" or die "$ME: duplicating stdout: $!\n";
+ open OLDERR, ">&STDERR" or die "$ME: duplicating stdout: $!\n";
+ *OLDERR = *OLDERR; # To pacify a "used only once" warning.
+ trap_perl_warnings_and_errors;
+ open STDOUT, ">&LOG" or die "$ME: redirecting stdout: $!\n";
+ open STDERR, ">&LOG" or die "$ME: redirecting stderr: $!\n";
+}
+
+sub setup_parser (@)
+{
+ local $@ = '';
+ eval { $parser = TAP::Parser->new ({exec => \@_, merge => $cfg{merge}}) };
+ if ($@ ne '')
+ {
+ # Don't use the error message in $@ as set by TAP::Parser, since
+ # currently it's both too generic (at the point of being basically
+ # useless) and quite long.
+ report "ERROR", "- couldn't execute test script";
+ finish;
+ }
+}
+
+sub get_test_exit_message ()
+{
+ my $wstatus = $parser->wait;
+ # Watch out for possible internal errors.
+ die "$ME: couldn't get the exit status of the TAP producer"
+ unless defined $wstatus;
+ # Return an undefined value if the producer exited with success.
+ return unless $wstatus;
+ # Otherwise, determine whether it exited with error or was terminated
+ # by a signal.
+ use POSIX qw (WIFEXITED WEXITSTATUS WIFSIGNALED WTERMSIG);
+ if (WIFEXITED ($wstatus))
+ {
+ return sprintf "exited with status %d", WEXITSTATUS ($wstatus);
+ }
+ elsif (WIFSIGNALED ($wstatus))
+ {
+ return sprintf "terminated by signal %d", WTERMSIG ($wstatus);
+ }
+ else
+ {
+ return "terminated abnormally";
+ }
+}
+
+sub stringify_result_obj ($)
+{
+ my $result_obj = shift;
+ my $COOKED_PASS = $cfg{"expect-failure"} ? "XPASS": "PASS";
+ my $COOKED_FAIL = $cfg{"expect-failure"} ? "XFAIL": "FAIL";
+ if ($result_obj->is_unplanned || $result_obj->number != $testno)
+ {
+ return "ERROR";
+ }
+ elsif ($plan_seen == LATE_PLAN)
+ {
+ return "ERROR";
+ }
+ elsif (!$result_obj->directive)
+ {
+ return $result_obj->is_ok ? $COOKED_PASS: $COOKED_FAIL;
+ }
+ elsif ($result_obj->has_todo)
+ {
+ return $result_obj->is_actual_ok ? "XPASS" : "XFAIL";
+ }
+ elsif ($result_obj->has_skip)
+ {
+ return $result_obj->is_ok ? "SKIP" : $COOKED_FAIL;
+ }
+ die "$ME: 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 "$ME: 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 testsuite_error ($)
+{
+ report "ERROR", "- $_[0]";
+}
+
+sub handle_tap_result ($)
+{
+ $testno++;
+ my $result_obj = shift;
+
+ my $test_result = stringify_result_obj $result_obj;
+ my $string = $result_obj->number;
+
+ my $description = $result_obj->description;
+ $string .= " $description"
+ unless is_null_string $description;
+
+ if ($plan_seen == LATE_PLAN)
+ {
+ $string .= " # AFTER LATE PLAN";
+ }
+ elsif ($result_obj->is_unplanned)
+ {
+ $string .= " # UNPLANNED";
+ }
+ elsif ($result_obj->number != $testno)
+ {
+ $string .= " # OUT-OF-ORDER (expecting $testno)";
+ }
+ elsif (my $directive = $result_obj->directive)
+ {
+ $string .= " # $directive";
+ my $explanation = $result_obj->explanation;
+ $string .= " $explanation"
+ unless is_null_string $explanation;
+ }
+
+ report $test_result, $string;
+}
+
+sub handle_tap_plan ($)
+{
+ my $plan = shift;
+ if ($plan_seen)
+ {
+ # Error, only one plan per stream is acceptable.
+ testsuite_error "multiple test plans";
+ return;
+ }
+ # The TAP plan can come before or after *all* the TAP results; we speak
+ # respectively of an "early" or a "late" plan. If we see the plan line
+ # after at least one TAP result has been seen, assume we have a late
+ # plan; in this case, any further test result seen after the plan will
+ # be flagged as an error.
+ $plan_seen = ($testno >= 1 ? LATE_PLAN : EARLY_PLAN);
+ # If $testno > 0, we have an error ("too many tests run") that will be
+ # automatically dealt with later, so don't worry about it here. If
+ # $plan_seen is true, we have an error due to a repeated plan, and that
+ # has already been dealt with above. Otherwise, we have a valid "plan
+ # with SKIP" specification, and should report it as a particular kind
+ # of SKIP result.
+ if ($plan->directive && $testno == 0)
+ {
+ my $explanation = is_null_string ($plan->explanation) ?
+ undef : "- " . $plan->explanation;
+ report "SKIP", $explanation;
+ }
+}
+
+sub handle_tap_bailout ($)
+{
+ my ($bailout, $msg) = ($_[0], "Bail out!");
+ $bailed_out = 1;
+ $msg .= " " . $bailout->explanation
+ unless is_null_string $bailout->explanation;
+ testsuite_error $msg;
+}
+
+sub extract_tap_comment ($)
+{
+ my $line = shift;
+ if (index ($line, $diag_string) == 0)
+ {
+ # Strip leading '$diag_string' from '$line'.
+ $line = substr ($line, length ($diag_string));
+ # And strip any leading and trailing whitespace left.
+ $line =~ s/(?:^\s*|\s*$)//g;
+ # Return what is left (if any).
+ return $line;
+ }
+ return "";
+}
+
+sub finish ()
+{
+ write_test_results;
+ close LOG or die "$ME: closing $log_file: $!\n";
+ exit 0;
+}
+
+sub main (@)
+{
+ setup_io;
+ setup_parser @_;
+
+ while (defined (my $cur = $parser->next))
+ {
+ # Verbatim copy any input line into the log file.
+ print $cur->raw . "\n";
+ # Parsing of TAP input should stop after a "Bail out!" directive.
+ next if $bailed_out;
+
+ if ($cur->is_plan)
+ {
+ handle_tap_plan ($cur);
+ }
+ elsif ($cur->is_test)
+ {
+ handle_tap_result ($cur);
+ }
+ elsif ($cur->is_bailout)
+ {
+ handle_tap_bailout ($cur);
+ }
+ elsif ($cfg{comments})
+ {
+ my $comment = extract_tap_comment ($cur->raw);
+ report "#", "$comment" if length $comment;
+ }
+ }
+ # A "Bail out!" directive should cause us to ignore any following TAP
+ # error, as well as a non-zero exit status from the TAP producer.
+ if (!$bailed_out)
+ {
+ if (!$plan_seen)
+ {
+ testsuite_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";
+ testsuite_error (sprintf "too %s tests run (expected %d, got %d)",
+ $bad_amount, $planned, $run);
+ }
+ if (!$cfg{"ignore-exit"})
+ {
+ my $msg = get_test_exit_message ();
+ testsuite_error $msg if $msg;
+ }
+ }
+ finish;
+}
+
+# ----------- #
+# Main code. #
+# ----------- #
+
+main @ARGV;
+
+# Local Variables:
+# perl-indent-level: 2
+# perl-continued-statement-offset: 2
+# perl-continued-brace-offset: 0
+# perl-brace-offset: 0
+# perl-brace-imaginary-offset: 0
+# perl-label-offset: -2
+# cperl-indent-level: 2
+# cperl-brace-offset: 0
+# cperl-continued-brace-offset: 0
+# cperl-label-offset: -2
+# cperl-extra-newline-before-brace: t
+# cperl-merge-trailing-else: nil
+# cperl-continued-statement-offset: 2
+# eval: (add-hook 'write-file-hooks 'time-stamp)
+# time-stamp-start: "my $VERSION = "
+# time-stamp-format: "'%:y-%02m-%02d.%02H'"
+# time-stamp-time-zone: "UTC"
+# time-stamp-end: "; # UTC"
+# End:
# Exit with error, even if all the tests have been successful.
exit 7
-% @kbd{cp @var{PREFIX}/share/automake-@var{APIVERSION}/tap-driver.pl .}
+% @kbd{cp @var{PREFIX}/share/automake-@var{APIVERSION}/tap-driver.sh .}
% @kbd{autoreconf -vi && ./configure && make check}
...
PASS: foo.test 1 - Swallows fly
shell_setup_code =>
'am_test_prefer_config_shell=yes',
},
- #
- # Tests on tap support should be run with both the perl and awk
- # implementations of the TAP driver (they run with the awk one
- # by default).
- #
- perl_tap_driver =>
- {
- line_matcher =>
- qr<(?:\bfetch_tap_driver\b|[\s/]tap-setup\.sh\b)>,
- line_rejecter =>
- qr/\bam_tap_implementation=/,
- shell_setup_code =>
- 'am_tap_implementation=perl',
- },
);
#--------------------------------------------------------------------------
%D%/py-compile \
%D%/ar-lib \
%D%/test-driver \
- %D%/tap-driver.sh \
- %D%/tap-driver.pl
+ %D%/tap-driver.sh
install-data-hook:
@$(POST_INSTALL)
+++ /dev/null
-#! /usr/bin/env perl
-# Copyright (C) 2011-2013 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 2, 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 <http://www.gnu.org/licenses/>.
-
-# As a special exception to the GNU General Public License, if you
-# distribute this file as part of a program that contains a
-# configuration script generated by Autoconf, you may include it under
-# the same distribution terms that you use for the rest of that program.
-
-# This file is maintained in Automake, please report
-# bugs to <bug-automake@gnu.org> or send patches to
-# <automake-patches@gnu.org>.
-
-# ---------------------------------- #
-# Imports, static data, and setup. #
-# ---------------------------------- #
-
-use warnings FATAL => 'all';
-use strict;
-use Getopt::Long ();
-use TAP::Parser;
-
-my $VERSION = '2012-02-01.19'; # UTC
-
-my $ME = "tap-driver.pl";
-
-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}] [--ignore-exit]
- [--diagnostic-string=STRING] [--merge|--no-merge]
- [--comments|--no-comments] [--] TEST-COMMAND
-The `--test-name', `--log-file' and `--trs-file' options are mandatory.
-END
-
-my $HELP = "$ME: TAP-aware test driver for Automake testsuite harness." .
- "\n" . $USAGE;
-
-# 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",
-);
-
-# It's important that NO_PLAN evaluates "false" as a boolean.
-use constant NO_PLAN => 0;
-use constant EARLY_PLAN => 1;
-use constant LATE_PLAN => 2;
-
-# ------------------- #
-# Global variables. #
-# ------------------- #
-
-my $testno = 0; # Number of test results seen so far.
-my $bailed_out = 0; # Whether a "Bail out!" directive has been seen.
-my $parser; # TAP parser object (will be initialized later).
-
-# Whether the TAP plan has been seen or not, and if yes, which kind
-# it is ("early" is seen before any test result, "late" otherwise).
-my $plan_seen = NO_PLAN;
-
-# ----------------- #
-# Option parsing. #
-# ----------------- #
-
-my %cfg = (
- "color-tests" => 0,
- "expect-failure" => 0,
- "merge" => 0,
- "comments" => 0,
- "ignore-exit" => 0,
-);
-
-my $test_script_name = undef;
-my $log_file = undef;
-my $trs_file = undef;
-my $diag_string = "#";
-
-Getopt::Long::GetOptions
- (
- 'help' => sub { print $HELP; exit 0; },
- 'version' => sub { print "$ME $VERSION\n"; exit 0; },
- 'test-name=s' => \$test_script_name,
- 'log-file=s' => \$log_file,
- 'trs-file=s' => \$trs_file,
- 'color-tests=s' => \&bool_opt,
- 'expect-failure=s' => \&bool_opt,
- 'enable-hard-errors=s' => sub {}, # No-op.
- 'diagnostic-string=s' => \$diag_string,
- '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;
-
-# ------------- #
-# Prototypes. #
-# ------------- #
-
-sub add_test_result ($);
-sub bool_opt ($$);
-sub colored ($$);
-sub copy_in_global_log ();
-sub decorate_result ($);
-sub extract_tap_comment ($);
-sub finish ();
-sub get_global_test_result ();
-sub get_test_exit_message ();
-sub get_test_results ();
-sub handle_tap_bailout ($);
-sub handle_tap_plan ($);
-sub handle_tap_result ($);
-sub is_null_string ($);
-sub main (@);
-sub must_recheck ();
-sub report ($;$);
-sub setup_io ();
-sub setup_parser (@);
-sub stringify_result_obj ($);
-sub testsuite_error ($);
-sub trap_perl_warnings_and_errors ();
-sub write_test_results ();
-sub yn ($);
-
-# -------------- #
-# 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 "$ME: invalid argument '$val' for option '$opt'\n";
- }
-}
-
-# If the given string is undefined or empty, return true, otherwise
-# return false. This function is useful to avoid pitfalls like:
-# if ($message) { print "$message\n"; }
-# which wouldn't print anything if $message is the literal "0".
-sub is_null_string ($)
-{
- my $str = shift;
- return ! (defined $str and length $str);
-}
-
-# Convert a boolean to a "yes"/"no" string.
-sub yn ($)
-{
- my $bool = shift;
- return $bool ? "yes" : "no";
-}
-
-TEST_RESULTS :
-{
- my (@test_results_list, %test_results_seen);
-
- sub add_test_result ($)
- {
- my $res = shift;
- push @test_results_list, $res;
- $test_results_seen{$res} = 1;
- }
-
- sub get_test_results ()
- {
- return @test_results_list;
- }
-
- # Whether the test script should be re-run by "make recheck".
- sub must_recheck ()
- {
- return grep { !/^(?:XFAIL|PASS|SKIP)$/ } (keys %test_results_seen);
- }
-
- # 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_seen);
- }
-
- # FIXME: this can certainly be improved ...
- sub get_global_test_result ()
- {
- return "ERROR"
- if $test_results_seen{"ERROR"};
- return "FAIL"
- if $test_results_seen{"FAIL"} || $test_results_seen{"XPASS"};
- return "SKIP"
- if scalar keys %test_results_seen == 1 && $test_results_seen{"SKIP"};
- return "PASS";
- }
-
-}
-
-sub write_test_results ()
-{
- open RES, ">", $trs_file or die "$ME: opening $trs_file: $!\n";
- print RES ":global-test-result: " . get_global_test_result . "\n";
- print RES ":recheck: " . yn (must_recheck) . "\n";
- print RES ":copy-in-global-log: " . yn (copy_in_global_log) . "\n";
- foreach my $result (get_test_results)
- {
- print RES ":test-result: $result\n";
- }
- close RES or die "$ME: closing $trs_file: $!\n";
-}
-
-sub trap_perl_warnings_and_errors ()
-{
- $SIG{__WARN__} = $SIG{__DIE__} = sub
- {
- # Be sure to send the warning/error message to the original stderr
- # (presumably the console), not into the log file.
- open STDERR, ">&OLDERR";
- die @_;
- }
-}
-
-sub setup_io ()
-{
- # Redirect stderr and stdout to a temporary log file. Save the
- # original stdout stream, since we need it to print testsuite
- # progress output. Save original stderr stream, so that we can
- # redirect warning and error messages from perl there.
- open LOG, ">", $log_file or die "$ME: opening $log_file: $!\n";
- open OLDOUT, ">&STDOUT" or die "$ME: duplicating stdout: $!\n";
- open OLDERR, ">&STDERR" or die "$ME: duplicating stdout: $!\n";
- *OLDERR = *OLDERR; # To pacify a "used only once" warning.
- trap_perl_warnings_and_errors;
- open STDOUT, ">&LOG" or die "$ME: redirecting stdout: $!\n";
- open STDERR, ">&LOG" or die "$ME: redirecting stderr: $!\n";
-}
-
-sub setup_parser (@)
-{
- local $@ = '';
- eval { $parser = TAP::Parser->new ({exec => \@_, merge => $cfg{merge}}) };
- if ($@ ne '')
- {
- # Don't use the error message in $@ as set by TAP::Parser, since
- # currently it's both too generic (at the point of being basically
- # useless) and quite long.
- report "ERROR", "- couldn't execute test script";
- finish;
- }
-}
-
-sub get_test_exit_message ()
-{
- my $wstatus = $parser->wait;
- # Watch out for possible internal errors.
- die "$ME: couldn't get the exit status of the TAP producer"
- unless defined $wstatus;
- # Return an undefined value if the producer exited with success.
- return unless $wstatus;
- # Otherwise, determine whether it exited with error or was terminated
- # by a signal.
- use POSIX qw (WIFEXITED WEXITSTATUS WIFSIGNALED WTERMSIG);
- if (WIFEXITED ($wstatus))
- {
- return sprintf "exited with status %d", WEXITSTATUS ($wstatus);
- }
- elsif (WIFSIGNALED ($wstatus))
- {
- return sprintf "terminated by signal %d", WTERMSIG ($wstatus);
- }
- else
- {
- return "terminated abnormally";
- }
-}
-
-sub stringify_result_obj ($)
-{
- my $result_obj = shift;
- my $COOKED_PASS = $cfg{"expect-failure"} ? "XPASS": "PASS";
- my $COOKED_FAIL = $cfg{"expect-failure"} ? "XFAIL": "FAIL";
- if ($result_obj->is_unplanned || $result_obj->number != $testno)
- {
- return "ERROR";
- }
- elsif ($plan_seen == LATE_PLAN)
- {
- return "ERROR";
- }
- elsif (!$result_obj->directive)
- {
- return $result_obj->is_ok ? $COOKED_PASS: $COOKED_FAIL;
- }
- elsif ($result_obj->has_todo)
- {
- return $result_obj->is_actual_ok ? "XPASS" : "XFAIL";
- }
- elsif ($result_obj->has_skip)
- {
- return $result_obj->is_ok ? "SKIP" : $COOKED_FAIL;
- }
- die "$ME: 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 "$ME: 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 testsuite_error ($)
-{
- report "ERROR", "- $_[0]";
-}
-
-sub handle_tap_result ($)
-{
- $testno++;
- my $result_obj = shift;
-
- my $test_result = stringify_result_obj $result_obj;
- my $string = $result_obj->number;
-
- my $description = $result_obj->description;
- $string .= " $description"
- unless is_null_string $description;
-
- if ($plan_seen == LATE_PLAN)
- {
- $string .= " # AFTER LATE PLAN";
- }
- elsif ($result_obj->is_unplanned)
- {
- $string .= " # UNPLANNED";
- }
- elsif ($result_obj->number != $testno)
- {
- $string .= " # OUT-OF-ORDER (expecting $testno)";
- }
- elsif (my $directive = $result_obj->directive)
- {
- $string .= " # $directive";
- my $explanation = $result_obj->explanation;
- $string .= " $explanation"
- unless is_null_string $explanation;
- }
-
- report $test_result, $string;
-}
-
-sub handle_tap_plan ($)
-{
- my $plan = shift;
- if ($plan_seen)
- {
- # Error, only one plan per stream is acceptable.
- testsuite_error "multiple test plans";
- return;
- }
- # The TAP plan can come before or after *all* the TAP results; we speak
- # respectively of an "early" or a "late" plan. If we see the plan line
- # after at least one TAP result has been seen, assume we have a late
- # plan; in this case, any further test result seen after the plan will
- # be flagged as an error.
- $plan_seen = ($testno >= 1 ? LATE_PLAN : EARLY_PLAN);
- # If $testno > 0, we have an error ("too many tests run") that will be
- # automatically dealt with later, so don't worry about it here. If
- # $plan_seen is true, we have an error due to a repeated plan, and that
- # has already been dealt with above. Otherwise, we have a valid "plan
- # with SKIP" specification, and should report it as a particular kind
- # of SKIP result.
- if ($plan->directive && $testno == 0)
- {
- my $explanation = is_null_string ($plan->explanation) ?
- undef : "- " . $plan->explanation;
- report "SKIP", $explanation;
- }
-}
-
-sub handle_tap_bailout ($)
-{
- my ($bailout, $msg) = ($_[0], "Bail out!");
- $bailed_out = 1;
- $msg .= " " . $bailout->explanation
- unless is_null_string $bailout->explanation;
- testsuite_error $msg;
-}
-
-sub extract_tap_comment ($)
-{
- my $line = shift;
- if (index ($line, $diag_string) == 0)
- {
- # Strip leading `$diag_string' from `$line'.
- $line = substr ($line, length ($diag_string));
- # And strip any leading and trailing whitespace left.
- $line =~ s/(?:^\s*|\s*$)//g;
- # Return what is left (if any).
- return $line;
- }
- return "";
-}
-
-sub finish ()
-{
- write_test_results;
- close LOG or die "$ME: closing $log_file: $!\n";
- exit 0;
-}
-
-sub main (@)
-{
- setup_io;
- setup_parser @_;
-
- while (defined (my $cur = $parser->next))
- {
- # Verbatim copy any input line into the log file.
- print $cur->raw . "\n";
- # Parsing of TAP input should stop after a "Bail out!" directive.
- next if $bailed_out;
-
- if ($cur->is_plan)
- {
- handle_tap_plan ($cur);
- }
- elsif ($cur->is_test)
- {
- handle_tap_result ($cur);
- }
- elsif ($cur->is_bailout)
- {
- handle_tap_bailout ($cur);
- }
- elsif ($cfg{comments})
- {
- my $comment = extract_tap_comment ($cur->raw);
- report "#", "$comment" if length $comment;
- }
- }
- # A "Bail out!" directive should cause us to ignore any following TAP
- # error, as well as a non-zero exit status from the TAP producer.
- if (!$bailed_out)
- {
- if (!$plan_seen)
- {
- testsuite_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";
- testsuite_error (sprintf "too %s tests run (expected %d, got %d)",
- $bad_amount, $planned, $run);
- }
- if (!$cfg{"ignore-exit"})
- {
- my $msg = get_test_exit_message ();
- testsuite_error $msg if $msg;
- }
- }
- finish;
-}
-
-# ----------- #
-# Main code. #
-# ----------- #
-
-main @ARGV;
-
-# Local Variables:
-# perl-indent-level: 2
-# perl-continued-statement-offset: 2
-# perl-continued-brace-offset: 0
-# perl-brace-offset: 0
-# perl-brace-imaginary-offset: 0
-# perl-label-offset: -2
-# cperl-indent-level: 2
-# cperl-brace-offset: 0
-# cperl-continued-brace-offset: 0
-# cperl-label-offset: -2
-# cperl-extra-newline-before-brace: t
-# cperl-merge-trailing-else: nil
-# cperl-continued-statement-offset: 2
-# eval: (add-hook 'write-file-hooks 'time-stamp)
-# time-stamp-start: "my $VERSION = "
-# time-stamp-format: "'%:y-%02m-%02d.%02H'"
-# time-stamp-time-zone: "UTC"
-# time-stamp-end: "; # UTC"
-# End:
# of /bin/sh.
get_shell_script ()
{
- test ! -f "$1" || rm -f "$1" || return 99
+ am_source=$1 am_target=${2-$1}
+ test ! -f "$am_target" || rm -f "$am_target" || return 99
if test x"$am_test_prefer_config_shell" = x"yes"; then
- sed "1s|#!.*|#! $SHELL|" "$am_scriptdir/$1" > "$1" \
- && chmod a+x "$1" \
+ sed "1s|#!.*|#! $SHELL|" "$am_scriptdir/$am_source" > "$am_target" \
+ && chmod a+x "$am_target" \
|| return 99
else
- cp -f "$am_scriptdir/$1" . || return 99
+ cp -f "$am_scriptdir/$am_source" "$am_target" || return 99
fi
- sed 10q "$1" # For debugging.
+ sed 10q "$am_target" # For debugging.
+ unset am_target am_source
}
+# fetch_tap_driver
+# ----------------
+# Fetch the Automake-provided TAP driver from the 'lib/' directory into
+# the current directory, and edit its shebang line so that it will be
+# run with the proper shell.
+fetch_tap_driver ()
+{
+ AM_TAP_AWK=$AWK; export AM_TAP_AWK
+ get_shell_script tap-driver.sh tap-driver
+}
+
+
# require_xsi SHELL
# -----------------
# Skip the test if the given shell fails to support common XSI constructs.
&& eval '\''test $(( 1 + 1 )) -eq 2 \
&& test "${#_lt_dummy}" -eq 5'\'
-# fetch_tap_driver
-# ----------------
-# Fetch the Automake-provided TAP driver from the 'lib/' directory into
-# the current directory, and edit its shebang line so that it will be
-# run with the perl interpreter determined at configure time.
-fetch_tap_driver ()
-{
- # TODO: we should devise a way to make the shell TAP driver tested also
- # TODO: with /bin/sh, for better coverage.
- case $am_tap_implementation in
- # Extra quoting required to avoid maintainer-check spurious failures.
- 'perl')
- $PERL -MTAP::Parser -e 1 \
- || skip_all_ "cannot import TAP::Parser perl module"
- sed "1s|#!.*|#! $PERL -w|" "$am_scriptdir"/tap-driver.pl >tap-driver
- ;;
- shell)
- AM_TAP_AWK=$AWK; export AM_TAP_AWK
- sed "1s|#!.*|#! $SHELL|" "$am_scriptdir"/tap-driver.sh >tap-driver
- ;;
- *)
- fatal_ "invalid \$am_tap_implementation '$am_tap_implementation'" ;;
- esac \
- && chmod a+x tap-driver \
- || framework_failure_ "couldn't fetch $am_tap_implementation TAP driver"
- sed 10q tap-driver # For debugging.
-}
-am_tap_implementation=${am_tap_implementation-shell}
-
# $PYTHON and support for PEP-3147. Needed to check our python-related
# install rules.
python_has_pep3147 ()
fi
# Check that no spurious test result is reported. This is lower-priority
-# (and in fact the check currently fails for our awk-based driver).
-directive=
-if test $am_tap_implementation = shell; then
- directive=TODO
-else
- # Older versions of IPC::Open3 (e.g., version 1.05 on perl 5.12.4 or
- # version 1.0103 on perl 5.6.2) fail to properly trap errors in exec(2)
- # calls in the child process; hence, the TAP driver cannot be properly
- # informed of such error.
- if $PERL -w -e '
- use IPC::Open3 qw/open3/;
- $@ = "";
- eval { open3(*STDIN, *STDOUT, *STDERR, "am--no-such-command") };
- $@ =~ m/\bopen3:.*am--no-such-command/
- or die "Bad \$@ value: \"$@\"\n";
- '; then
- : # OK. IPC::Open3 should be good enough.
- else
- for s in '"missing plan" message' 'results'; do
- skip_ -r "IPC::Open3 not good enough" "no spurious $s"
- done
- exit 0
- fi
-fi
+# (and in fact the check currently fails).
command_ok_ 'no spurious "missing plan" message' \
- -D "$directive" -- not grep 'missing.* plan' stdout
+ -D TODO -- not grep 'missing.* plan' stdout
+
command_ok_ 'no spurious results' \
- -D "$directive" -r 'still get "missing plan"' \
+ -D TODO -r 'still get "missing plan"' \
count_test_results total=3 pass=0 fail=0 xpass=0 xfail=0 skip=0 error=3
:
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
-# Older versions of prove and TAP::Harness (e.g., 3.17) didn't recognize
-# a "Bail out!" directive that was preceded by whitespace, but more modern
-# versions (e.g., 3.23) do. So we leave this behaviour undefined for the
-# perl implementation of the Automake TAP driver, but expect the latter,
-# "more modern" behaviour in our awk TAP driver.
+# A "Bail out!" directive that is preceded by whitespace should still
+# be recognized.
-am_tap_implementation=shell
. test-init.sh
-
. tap-setup.sh
cat > a.test <<END
esac
wbound_re="($|[^a-zA-Z0-9_-])"
pfx_re="^ERROR: signal-$numeric\\.test"
- case $am_tap_implementation in
- # Dummy escape to please maintainer-check.
- per\l) rx="$pfx_re - terminated by signal $sig_re$";;
- shell) rx="$pfx_re .*terminated by signal $sig_re$wbound_re";;
- *) fatal_ "invalid \$am_tap_implementation '$am_tap_implementation'";;
- esac
- desc="TAP driver catch test termination by signal SIG$symbolic"
+ rx="${pfx_re} .*terminated by signal ${sig_re}${wbound_re}"
+ desc="TAP driver catch test termination by signal SIG${symbolic}"
case " $blocked_signals " in
*" $numeric "*) skip_ -r "SIG$symbolic is blocked" "$desc" ;;
*) command_ok_ "$desc" env LC_ALL=C $EGREP "$rx" stdout ;;
# This is consistent with the behaviour of the 'prove' utility.
. test-init.sh
-
-if test $am_tap_implementation = perl; then
- $PERL -MTAP::Parser -e 1 \
- || skip_ "cannot import TAP::Parser perl module"
- if $PERL -w -e '
- use warnings FATAL => "all"; use strict;
- use TAP::Parser;
- my $parser = TAP::Parser->new({tap => "1..1\n" . "ok 0\n"});
- my $result = $parser->next;
- $result->is_plan or die "first line is not TAP plan";
- $result = $parser->next;
- $result->is_test or die "second line is not TAP test result";
- my $testno = $result->number;
- $parser->next and die "unexpected further TAP stream";
- exit ($testno == 0 ? 0 : 77);
- '; then
- : # Nothing to do.
- elif test $? -eq 77; then
- skip_ 'TAP::Parser bug: test number 0 gets relabelled as 1'
- else
- fatal_ "error analyzing TAP::Parser module for bugs"
- fi
-fi
-
. tap-setup.sh
cat > a.test <<END
cp "$am_testaux_srcdir"/trivial-test-driver . \
|| fatal_ "failed to fetch auxiliary script trivial-test-driver"
-cp "$am_scriptdir"/tap-driver.pl . \
- || fatal_ "failed to fetch auxiliary script tap-driver.pl"
+cp "$am_scriptdir"/tap-driver.sh . \
+ || fatal_ "failed to fetch auxiliary script tap-driver.sh"
cat >> configure.ac << END
AM_CONDITIONAL([COND1], [:])
cat > Makefile.am << 'END'
TESTS = foo bar.test baz.sh
-EXTRA_DIST = $(TESTS) tap-driver.pl trivial-test-driver
+EXTRA_DIST = $(TESTS) tap-driver.sh trivial-test-driver
TEST_EXTENSIONS = .test .sh
LOG_DRIVER =
SH_LOG_DRIVER = $(tap_rulez)
if COND2
tap_rulez = false
else !COND2
-tap_rulez = $(PERL) $(srcdir)/tap-driver.pl
+tap_rulez = $(PERL) $(srcdir)/tap-driver.sh
endif !COND2
endif COND1
END
projects / platform / upstream / automake.git / commitdiff