Latest update.
This commit is contained in:
+46
-34
@@ -132,6 +132,7 @@ is defined).
|
||||
sub setup {
|
||||
my $old_test_name = $test_name;
|
||||
$test_name = shift;
|
||||
my %opts = @_;
|
||||
|
||||
BAIL_OUT("setup() must receive a name") unless $test_name;
|
||||
warn "setup() detected test name change. Innocuous, so we continue...\n"
|
||||
@@ -149,6 +150,9 @@ sub setup {
|
||||
BAIL_OUT("setup() expects the file Configure in the source top directory")
|
||||
unless -f srctop_file("Configure");
|
||||
|
||||
note "The results of this test will end up in $directories{RESULTS}"
|
||||
unless $opts{quiet};
|
||||
|
||||
__cwd($directories{RESULTS});
|
||||
}
|
||||
|
||||
@@ -170,12 +174,6 @@ When set to 1 (or any value that perl perceives as true), the subdirectory
|
||||
will be created if it doesn't already exist. This happens before BLOCK
|
||||
is executed.
|
||||
|
||||
=item B<cleanup =E<gt> 0|1>
|
||||
|
||||
When set to 1 (or any value that perl perceives as true), the subdirectory
|
||||
will be cleaned out and removed. This happens both before and after BLOCK
|
||||
is executed.
|
||||
|
||||
=back
|
||||
|
||||
An example:
|
||||
@@ -188,7 +186,7 @@ An example:
|
||||
is($line, qr/^OpenSSL 1\./,
|
||||
"check that we're using OpenSSL 1.x.x");
|
||||
}
|
||||
}, create => 1, cleanup => 1;
|
||||
}, create => 1;
|
||||
|
||||
=back
|
||||
|
||||
@@ -206,10 +204,6 @@ sub indir {
|
||||
$codeblock->();
|
||||
|
||||
__cwd($reverse);
|
||||
|
||||
if ($opts{cleanup}) {
|
||||
rmtree($subdir, { safe => 0 });
|
||||
}
|
||||
}
|
||||
|
||||
=over 4
|
||||
@@ -943,17 +937,22 @@ i.e. Some tests may only work in non FIPS mode.
|
||||
sub __env {
|
||||
(my $recipe_datadir = basename($0)) =~ s/\.t$/_data/i;
|
||||
|
||||
$directories{SRCTOP} = abs_path($ENV{SRCTOP} || $ENV{TOP});
|
||||
$directories{BLDTOP} = abs_path($ENV{BLDTOP} || $ENV{TOP});
|
||||
$directories{BLDAPPS} = $ENV{BIN_D} || __bldtop_dir("apps");
|
||||
$directories{SRCAPPS} = __srctop_dir("apps");
|
||||
$directories{BLDFUZZ} = __bldtop_dir("fuzz");
|
||||
$directories{SRCFUZZ} = __srctop_dir("fuzz");
|
||||
$directories{BLDTEST} = $ENV{TEST_D} || __bldtop_dir("test");
|
||||
$directories{SRCTEST} = __srctop_dir("test");
|
||||
$directories{SRCDATA} = __srctop_dir("test", "recipes",
|
||||
$recipe_datadir);
|
||||
$directories{RESULTS} = $ENV{RESULT_D} || $directories{BLDTEST};
|
||||
$directories{SRCTOP} = abs_path($ENV{SRCTOP} || $ENV{TOP});
|
||||
$directories{BLDTOP} = abs_path($ENV{BLDTOP} || $ENV{TOP});
|
||||
$directories{BLDAPPS} = $ENV{BIN_D} || __bldtop_dir("apps");
|
||||
$directories{SRCAPPS} = __srctop_dir("apps");
|
||||
$directories{BLDFUZZ} = __bldtop_dir("fuzz");
|
||||
$directories{SRCFUZZ} = __srctop_dir("fuzz");
|
||||
$directories{BLDTEST} = $ENV{TEST_D} || __bldtop_dir("test");
|
||||
$directories{SRCTEST} = __srctop_dir("test");
|
||||
$directories{SRCDATA} = __srctop_dir("test", "recipes",
|
||||
$recipe_datadir);
|
||||
$directories{RESULTTOP} = $ENV{RESULT_D} || __bldtop_dir("test-runs");
|
||||
$directories{RESULTS} = catdir($directories{RESULTTOP}, $test_name);
|
||||
|
||||
# Create result directory dynamically
|
||||
rmtree($directories{RESULTS}, { safe => 0, keep_root => 1 });
|
||||
mkpath($directories{RESULTS});
|
||||
|
||||
push @direnv, "TOP" if $ENV{TOP};
|
||||
push @direnv, "SRCTOP" if $ENV{SRCTOP};
|
||||
@@ -962,7 +961,7 @@ sub __env {
|
||||
push @direnv, "TEST_D" if $ENV{TEST_D};
|
||||
push @direnv, "RESULT_D" if $ENV{RESULT_D};
|
||||
|
||||
$end_with_bailout = $ENV{STOPTEST} ? 1 : 0;
|
||||
$end_with_bailout = $ENV{STOPTEST} ? 1 : 0;
|
||||
};
|
||||
|
||||
# __srctop_file and __srctop_dir are helpers to build file and directory
|
||||
@@ -1079,7 +1078,6 @@ sub __results_file {
|
||||
# hash style arguments to alter __cwd's behavior:
|
||||
#
|
||||
# create = 0|1 The directory we move to is created if 1, not if 0.
|
||||
# cleanup = 0|1 The directory we move from is removed if 1, not if 0.
|
||||
|
||||
sub __cwd {
|
||||
my $dir = catdir(shift);
|
||||
@@ -1137,10 +1135,6 @@ sub __cwd {
|
||||
# Should we just bail out here as well? I'm unsure.
|
||||
return undef unless chdir($dir);
|
||||
|
||||
if ($opts{cleanup}) {
|
||||
rmtree(".", { safe => 0, keep_root => 1 });
|
||||
}
|
||||
|
||||
# We put back new values carefully. Doing the obvious
|
||||
# %directories = ( %tmp_directories )
|
||||
# will clear out any value that happens to be an absolute path
|
||||
@@ -1184,13 +1178,31 @@ sub __wrap_cmd {
|
||||
my $cmd = shift;
|
||||
my $exe_shell = shift;
|
||||
|
||||
my @prefix = ( __bldtop_file("util", "shlib_wrap.sh") );
|
||||
my @prefix = ();
|
||||
|
||||
if(defined($exe_shell)) {
|
||||
@prefix = ( $exe_shell );
|
||||
} elsif ($^O eq "VMS" || $^O eq "MSWin32") {
|
||||
# VMS and Windows don't use any wrapper script for the moment
|
||||
@prefix = ();
|
||||
if (defined($exe_shell)) {
|
||||
# If $exe_shell is defined, trust it
|
||||
@prefix = ( $exe_shell );
|
||||
} else {
|
||||
# Otherwise, use the standard wrapper
|
||||
my $std_wrapper = __bldtop_file("util", "wrap.pl");
|
||||
|
||||
if ($^O eq "VMS") {
|
||||
# On VMS, running random executables without having a command
|
||||
# symbol means running them with the MCR command. This is an
|
||||
# old PDP-11 command that stuck around. So we get a command
|
||||
# running perl running the script.
|
||||
@prefix = ( "MCR", $^X, $std_wrapper );
|
||||
} elsif ($^O eq "MSWin32") {
|
||||
# In the Windows case, we run perl explicitly. We might not
|
||||
# need it, but that depends on if the user has associated the
|
||||
# '.pl' extension with a perl interpreter, so better be safe.
|
||||
@prefix = ( $^X, $std_wrapper );
|
||||
} else {
|
||||
# Otherwise, we assume Unix semantics, and trust that the #!
|
||||
# line activates perl for us.
|
||||
@prefix = ( $std_wrapper );
|
||||
}
|
||||
}
|
||||
|
||||
return (@prefix, $cmd);
|
||||
|
||||
Reference in New Issue
Block a user