X-Git-Url: https://git.openssl.org/gitweb/?a=blobdiff_plain;f=test%2Ftestlib%2FOpenSSL%2FTest.pm;h=1e9730bcdceba081900204d64508b34436b41ff2;hb=78e91586fbeb2c3a54d2a8a28dadeeb1eb0f57a8;hp=c2b9f5c589625ca6e55f294fd539ca1023f9d396;hpb=3eefcea116b8143e99fbd9681ef8e364113c2d23;p=openssl.git diff --git a/test/testlib/OpenSSL/Test.pm b/test/testlib/OpenSSL/Test.pm index c2b9f5c589..1e9730bcdc 100644 --- a/test/testlib/OpenSSL/Test.pm +++ b/test/testlib/OpenSSL/Test.pm @@ -1,3 +1,10 @@ +# Copyright 2016 The OpenSSL Project Authors. All Rights Reserved. +# +# Licensed under the OpenSSL license (the "License"). You may not use +# this file except in compliance with the License. You can obtain a copy +# in the file LICENSE in the source distribution or at +# https://www.openssl.org/source/license.html + package OpenSSL::Test; use strict; @@ -60,6 +67,11 @@ my $test_name = undef; # (mandatory), BIN_D, TEST_D, UTIL_D and RESULT_D. my %directories = (); +# The environment variables that gave us the contents in %directories. These +# get modified whenever we change directories, so that subprocesses can use +# the values of those environment variables as well +my @direnv = (); + # A bool saying if we shall stop all testing if the current recipe has failing # tests or not. This is set by setup() if the environment variable STOPTEST # is defined with a non-empty value. @@ -341,6 +353,16 @@ sub run { my $r = 0; my $e = 0; + # In non-verbose, we want to shut up the command interpreter, in case + # it has something to complain about. On VMS, it might complain both + # on stdout and stderr + *save_STDOUT = *STDOUT; + *save_STDERR = *STDERR; + if ($ENV{HARNESS_ACTIVE} && !$ENV{HARNESS_VERBOSE}) { + open STDOUT, ">", devnull(); + open STDERR, ">", devnull(); + } + # The dance we do with $? is the same dance the Unix shells appear to # do. For example, a program that gets aborted (and therefore signals # SIGABRT = 6) will appear to exit with the code 134. We mimic this @@ -354,7 +376,14 @@ sub run { $r = $hooks{exit_checker}->($e); } - print STDERR "$prefix$cmd => $e\n" + if ($ENV{HARNESS_ACTIVE} && !$ENV{HARNESS_VERBOSE}) { + close STDOUT; + close STDERR; + } + *STDOUT = *save_STDOUT; + *STDERR = *save_STDERR; + + print STDERR "$prefix$display_cmd => $e\n" if !$ENV{HARNESS_ACTIVE} || $ENV{HARNESS_VERBOSE}; # At this point, $? stops being interesting, and unfortunately, @@ -548,19 +577,42 @@ sub with { =over 4 -=item B +=item B C takes a CODEREF from C or C and simply returns the command as a string. +C takes some additiona options OPTS that affect the string returned: + +=over 4 + +=item B 0|1> + +When set to 0, the returned string will be with all decorations, such as a +possible redirect of stderr to the null device. This is suitable if the +string is to be used directly in a recipe. + +When set to 1, the returned string will be without extra decorations. This +is suitable for display if that is desired (doesn't confuse people with all +internal stuff), or if it's used to pass a command down to a subprocess. + +Default: 0 + +=back + =back =cut sub cmdstr { my ($cmd, $display_cmd) = shift->(0); + my %opts = @_; - return $display_cmd; + if ($opts{display}) { + return $display_cmd; + } else { + return $cmd; + } } =over 4 @@ -651,6 +703,13 @@ sub __env { $directories{SRCTEST} = __srctop_dir("test"); $directories{RESULTS} = $ENV{RESULT_D} || $directories{BLDTEST}; + push @direnv, "TOP" if $ENV{TOP}; + push @direnv, "SRCTOP" if $ENV{SRCTOP}; + push @direnv, "BLDTOP" if $ENV{BLDTOP}; + push @direnv, "BIN_D" if $ENV{BIN_D}; + push @direnv, "TEST_D" if $ENV{TEST_D}; + push @direnv, "RESULT_D" if $ENV{RESULT_D}; + $end_with_bailout = $ENV{STOPTEST} ? 1 : 0; }; @@ -680,11 +739,21 @@ sub __bldtop_dir { return catdir($directories{BLDTOP},@_); } +sub __exeext { + my $ext = ""; + if ($^O eq "VMS" ) { # VMS + $ext = ".exe"; + } elsif ($^O eq "MSWin32") { # Windows + $ext = ".exe"; + } + return $ENV{"EXE_EXT"} || $ext; +} + sub __test_file { BAIL_OUT("Must run setup() first") if (! $test_name); my $f = pop; - $f = catfile($directories{BLDTEST},@_,$f); + $f = catfile($directories{BLDTEST},@_,$f . __exeext()); $f = catfile($directories{SRCTEST},@_,$f) unless -x $f; return $f; } @@ -702,7 +771,7 @@ sub __apps_file { BAIL_OUT("Must run setup() first") if (! $test_name); my $f = pop; - $f = catfile($directories{BLDAPPS},@_,$f); + $f = catfile($directories{BLDAPPS},@_,$f . __exeext()); $f = catfile($directories{SRCAPPS},@_,$f) unless -x $f; return $f; } @@ -768,6 +837,16 @@ sub __cwd { } } + # Treat each environment variable that was used to get us the values in + # %directories the same was as the paths in %directories, so any sub + # process can use their values properly as well + foreach (@direnv) { + if (!file_name_is_absolute($ENV{$_})) { + my $newpath = abs2rel(rel2abs($ENV{$_}), rel2abs($dir)); + $ENV{$_} = $newpath; + } + } + if ($debug) { print STDERR "DEBUG: __cwd(), directories and files:\n"; print STDERR " \$directories{BLDTEST} = \"$directories{BLDTEST}\"\n"; @@ -790,23 +869,20 @@ sub __fixup_cmd { my $exe_shell = shift; my $prefix = __bldtop_file("util", "shlib_wrap.sh")." "; - my $ext = $ENV{"EXE_EXT"} || ""; if (defined($exe_shell)) { $prefix = "$exe_shell "; } elsif ($^O eq "VMS" ) { # VMS $prefix = ($prog =~ /^(?:[\$a-z0-9_]+:)?[<\[]/i ? "mcr " : "mcr []"); - $ext = ".exe"; } elsif ($^O eq "MSWin32") { # Windows $prefix = ""; - $ext = ".exe"; } # We test both with and without extension. The reason # is that we might be passed a complete file spec, with # extension. if ( ! -x $prog ) { - my $prog = "$prog$ext"; + my $prog = "$prog"; if ( ! -x $prog ) { $prog = undef; }