Rework test/run_tests.pl to support selective verbosity and TAP copy

This includes a complete rework of how we use TAP::Harness, by adding
a TAP::Parser subclass that allows additional callbacks to be passed
to perform what we need.  The TAP::Parser callbacks we add are:

    ALL         to print all the TAP output to a file (conditionally)
                to collect all the TAP output to an array (conditionally)
    EOF         to print all the collected TAP output (if there is any)
                if any subtest failed

To get TAP output to file, the environment variable HARNESS_TAP_COPY
must be defined, with a file name as value.  That file will be
overwritten unconditionally.

To get TAP output displayed on failure, the make variable VERBOSE_FAILURE
or VF must be defined with a non-emoty value.

Additionally, the output of test recipe names has been changed to only
display its basename.

Reviewed-by: Matt Caswell <matt@openssl.org>
(Merged from https://github.com/openssl/openssl/pull/9862)

1 files changed, 152 insertions, 53 deletions

diff --git a/test/run_tests.pl b/test/run_tests.pl
index a7f35e1956..bb91761563 100644
--- a/test/run_tests.pl
+++ b/test/run_tests.pl
@@ -10,8 +10,10 @@ use strict;
 use warnings;
 
 # Recognise VERBOSE and V which is common on other projects.
+# Additionally, also recognise VERBOSE_FAILURE and VF.
 BEGIN {
     $ENV{HARNESS_VERBOSE} = "yes" if $ENV{VERBOSE} || $ENV{V};
+    $ENV{HARNESS_VERBOSE_FAILURE} = "yes" if $ENV{VERBOSE_FAILURE} || $ENV{VF};
 }
 
 use File::Spec::Functions qw/catdir catfile curdir abs2rel rel2abs/;
@@ -20,9 +22,6 @@ use FindBin;
 use lib "$FindBin::Bin/../util/perl";
 use OpenSSL::Glob;
 
-my $TAP_Harness = eval { require TAP::Harness } ? "TAP::Harness"
-                                                : "OpenSSL::TAP::Harness";
-
 my $srctop = $ENV{SRCTOP} || $ENV{TOP};
 my $bldtop = $ENV{BLDTOP} || $ENV{TOP};
 my $recipesdir = catdir($srctop, "test", "recipes");
@@ -31,12 +30,25 @@ my $libdir = rel2abs(catdir($srctop, "util", "perl"));
 $ENV{OPENSSL_CONF} = catdir($srctop, "apps", "openssl.cnf");
 
 my %tapargs =
-    ( verbosity => $ENV{VERBOSE} || $ENV{V} || $ENV{HARNESS_VERBOSE} ? 1 : 0,
-      lib       => [ $libdir ],
-      switches  => '-w',
-      merge     => 1
+    ( verbosity         => $ENV{HARNESS_VERBOSE} ? 1 : 0,
+      lib               => [ $libdir ],
+      switches          => '-w',
+      merge             => 1,
     );
 
+# Additional OpenSSL special TAP arguments.  Because we can't pass them via
+# TAP::Harness->new(), they will be accessed directly, see the
+# TAP::Parser::OpenSSL implementation further down
+my %openssl_args = ();
+
+$openssl_args{'failure_verbosity'} =
+    $ENV{HARNESS_VERBOSE_FAILURE} && $tapargs{verbosity} < 1 ? 1 : 0;
+
+my $outfilename = $ENV{HARNESS_TAP_COPY};
+open $openssl_args{'tap_copy'}, ">$outfilename"
+    or die "Trying to create $outfilename: $!\n"
+    if defined $outfilename;
+
 my @alltests = find_matching_tests("*");
 my %tests = ();
 
@@ -52,7 +64,7 @@ foreach my $arg (@ARGV ? @ARGV : ('alltests')) {
     if ($arg eq 'alltests') {
 	warn "'alltests' encountered, ignoring everything before that...\n"
 	    unless $initial_arg;
-	%tests = map { $_ => 1 } @alltests;
+	%tests = map { $_ => basename($_) } @alltests;
     } elsif ($arg =~ m/^(-?)(.*)/) {
 	my $sign = $1;
 	my $test = $2;
@@ -60,7 +72,7 @@ foreach my $arg (@ARGV ? @ARGV : ('alltests')) {
 
 	# If '-foo' is the first arg, it's short for 'alltests -foo'
 	if ($sign eq '-' && $initial_arg) {
-	    %tests = map { $_ => 1 } @alltests;
+	    %tests = map { $_ => basename($_) } @alltests;
 	}
 
 	if (scalar @matches == 0) {
@@ -72,7 +84,7 @@ foreach my $arg (@ARGV ? @ARGV : ('alltests')) {
 		if ($sign eq '-') {
 		    delete $tests{$test};
 		} else {
-		    $tests{$test} = 1;
+		    $tests{$test} = basename($test);
 		}
 	    }
 	}
@@ -83,21 +95,6 @@ foreach my $arg (@ARGV ? @ARGV : ('alltests')) {
     $initial_arg = 0;
 }
 
-my $harness = $TAP_Harness->new(\%tapargs);
-my $ret = $harness->runtests(map { abs2rel($_, rel2abs(curdir())); }
-                                 sort keys %tests);
-
-# $ret->has_errors may be any number, not just 0 or 1.  On VMS, numbers
-# from 2 and on are used as is as VMS statuses, which has severity encoded
-# in the lower 3 bits.  0 and 1, on the other hand, generate SUCCESS and
-# FAILURE, so for currect reporting on all platforms, we make sure the only
-# exit codes are 0 and 1.  Double-bang is the trick to do so.
-exit !!$ret->has_errors if (ref($ret) eq "TAP::Parser::Aggregator");
-
-# If this isn't a TAP::Parser::Aggregator, it's the pre-TAP test harness,
-# which simply dies at the end if any test failed, so we don't need to bother
-# with any exit code in that case.
-
 sub find_matching_tests {
     my ($glob) = @_;
 
@@ -107,37 +104,139 @@ sub find_matching_tests {
     return glob(catfile($recipesdir,"*-$glob.t"));
 }
 
+# The following is quite a bit of hackery to adapt to both TAP::Harness
+# and Test::Harness, depending on what's available.
+# The TAP::Harness hack allows support for HARNESS_VERBOSE_FAILURE and
+# HARNESS_TAP_COPY, while the Test::Harness hack can't, because the pre
+# TAP::Harness Test::Harness simply doesn't have support for this sort of
+# thing.
+#
+# We use eval to avoid undue interruption if TAP::Harness isn't present.
+
+my $package;
+my $eres;
+
+$eres = eval {
+    package TAP::Parser::OpenSSL;
+    use parent 'TAP::Parser';
+
+    sub new {
+        my $class = shift;
+        my %opts = %{ shift() };
+
+        # We rely heavily on perl closures to make failure verbosity work
+        # We need to do so, because there's no way to safely pass extra
+        # objects down all the way to the TAP::Parser::Result object
+        my @failure_output = ();
+        my %callbacks = ();
+        if ($openssl_args{failure_verbosity}
+            || defined $openssl_args{tap_copy}) {
+            $callbacks{ALL} = sub {
+                my $self = shift;
+                my $fh = $openssl_args{tap_copy};
+
+                print $fh $self->as_string, "\n"
+                    if defined $fh;
+                push @failure_output, $self->as_string
+                    if $openssl_args{failure_verbosity} > 0;
+            };
+        }
+
+        if ($openssl_args{failure_verbosity} > 0) {
+            $callbacks{EOF} = sub {
+                my $self = shift;
+
+                # We know we are a TAP::Parser::Aggregator object
+                if (scalar $self->failed > 0 && @failure_output) {
+                    # We add an extra empty line, because in the case of a
+                    # progress counter, we're still at the end of that progress
+                    # line.
+                    print $_, "\n" foreach (("", @failure_output));
+                }
+            };
+        }
+
+        if (keys %callbacks) {
+            # If %opts already has a callbacks element, the order here
+            # ensures we do not override it
+            %opts = ( callbacks => { %callbacks }, %opts );
+        }
+
+        return $class->SUPER::new({ %opts });
+    }
 
-# Fake TAP::Harness in case it's not loaded
-use Test::Harness;
-package OpenSSL::TAP::Harness;
-
-sub new {
-    my $class = shift;
-    my %args = %{ shift() };
+    package TAP::Harness::OpenSSL;
+    use parent 'TAP::Harness';
+
+    package main;
+
+    $tapargs{parser_class} = "TAP::Parser::OpenSSL";
+    $package = 'TAP::Harness::OpenSSL';
+};
+
+unless (defined $eres) {
+    $eres = eval {
+        # Fake TAP::Harness in case it's not loaded
+        package TAP::Harness::fake;
+        use parent 'Test::Harness';
+
+        sub new {
+            my $class = shift;
+            my %args = %{ shift() };
+
+            return bless { %args }, $class;
+        }
+
+        sub runtests {
+            my $self = shift;
+
+            # Pre TAP::Harness Test::Harness doesn't support [ filename, name ]
+            # elements, so convert such elements to just be the filename
+            my @args = map { ref($_) eq 'ARRAY' ? $_->[0] : $_ } @_;
+
+            my @switches = ();
+            if ($self->{switches}) {
+                push @switches, $self->{switches};
+            }
+            if ($self->{lib}) {
+                foreach (@{$self->{lib}}) {
+                    my $l = $_;
+
+                    # It seems that $switches is getting interpreted with 'eval'
+                    # or something like that, and that we need to take care of
+                    # backslashes or they will disappear along the way.
+                    $l =~ s|\\|\\\\|g if $^O eq "MSWin32";
+                    push @switches, "-I$l";
+                }
+            }
+
+            $Test::Harness::switches = join(' ', @switches);
+            Test::Harness::runtests(@args);
+        }
+
+        package main;
+        $package = 'TAP::Harness::fake';
+    };
+}
 
-    return bless { %args }, $class;
+unless (defined $eres) {
+    print $@,"\n" if $@;
+    print $!,"\n" if $!;
+    exit 127;
 }
 
-sub runtests {
-    my $self = shift;
+my $harness = $package->new(\%tapargs);
+my $ret =
+    $harness->runtests(map { [ abs2rel($_, rel2abs(curdir())), $tests{$_} ] }
+                       sort keys %tests);
 
-    my @switches = ();
-    if ($self->{switches}) {
-	push @switches, $self->{switches};
-    }
-    if ($self->{lib}) {
-	foreach (@{$self->{lib}}) {
-	    my $l = $_;
-
-	    # It seems that $switches is getting interpreted with 'eval' or
-	    # something like that, and that we need to take care of backslashes
-	    # or they will disappear along the way.
-	    $l =~ s|\\|\\\\|g if $^O eq "MSWin32";
-	    push @switches, "-I$l";
-	}
-    }
+# $ret->has_errors may be any number, not just 0 or 1.  On VMS, numbers
+# from 2 and on are used as is as VMS statuses, which has severity encoded
+# in the lower 3 bits.  0 and 1, on the other hand, generate SUCCESS and
+# FAILURE, so for currect reporting on all platforms, we make sure the only
+# exit codes are 0 and 1.  Double-bang is the trick to do so.
+exit !!$ret->has_errors if (ref($ret) eq "TAP::Parser::Aggregator");
 
-    $Test::Harness::switches = join(' ', @switches);
-    Test::Harness::runtests(@_);
-}
+# If this isn't a TAP::Parser::Aggregator, it's the pre-TAP test harness,
+# which simply dies at the end if any test failed, so we don't need to bother
+# with any exit code in that case.