[openssl-commits] [openssl] master update
Richard Levitte
levitte at openssl.org
Wed Oct 19 15:14:48 UTC 2016
The branch master has been updated
via e972273194303e15f8dd7ce69dbcfa27cc024e9f (commit)
via 753663a9e5d3b105e713de45ae9704ce32fb01fb (commit)
via 42aa720d188e487dae93d75dc9796a4aa68f6ff4 (commit)
via 28e0f6eb7eb7a777e26ea601851e2982a75981af (commit)
via 9ddf67f34dd13427d7df5f5169f3c26e6ac06caa (commit)
from 50c3fc00cc3090d082669591c0923a8468f2d8f9 (commit)
- Log -----------------------------------------------------------------
commit e972273194303e15f8dd7ce69dbcfa27cc024e9f
Author: Richard Levitte <levitte at openssl.org>
Date: Tue Oct 18 20:55:07 2016 +0200
OpenSSL::Test - small fixup
Reviewed-by: Matt Caswell <matt at openssl.org>
(Merged from https://github.com/openssl/openssl/pull/1686)
commit 753663a9e5d3b105e713de45ae9704ce32fb01fb
Author: Richard Levitte <levitte at openssl.org>
Date: Mon Oct 17 07:06:39 2016 +0200
OpenSSL::Test cleanup - no forward declarations needed
Reviewed-by: Matt Caswell <matt at openssl.org>
(Merged from https://github.com/openssl/openssl/pull/1686)
commit 42aa720d188e487dae93d75dc9796a4aa68f6ff4
Author: Richard Levitte <levitte at openssl.org>
Date: Thu Oct 13 10:44:33 2016 +0200
appveyor: make tests verbose
Reviewed-by: Matt Caswell <matt at openssl.org>
(Merged from https://github.com/openssl/openssl/pull/1686)
commit 28e0f6eb7eb7a777e26ea601851e2982a75981af
Author: Richard Levitte <levitte at openssl.org>
Date: Fri Oct 14 23:05:30 2016 +0200
Add documentation of internal OpenSSL::Test functions
Also, fix __wrap_cmd so it doesn't return unnecessary empty strings
Reviewed-by: Matt Caswell <matt at openssl.org>
(Merged from https://github.com/openssl/openssl/pull/1686)
commit 9ddf67f34dd13427d7df5f5169f3c26e6ac06caa
Author: Richard Levitte <levitte at openssl.org>
Date: Mon Oct 10 22:13:27 2016 +0200
Make OpenSSL::Test a bit more flexible
So far, apps and test programs, were a bit rigidely accessible as
executables or perl scripts. But what about scripts in some other
language? Or what about running entirely external programs? The
answer is certainly not to add new functions to access scripts for
each language or wrapping all the external program calls in our magic!
Instead, this adds a new functions, cmd(), which is useful to access
executables and scripts in a more generalised manner. app(), test(),
fuzz(), perlapp() and perltest() are rewritten in terms of cmd(), and
serve as examples how to do something similar for other scripting
languages, or constrain the programs to certain directories.
Reviewed-by: Matt Caswell <matt at openssl.org>
(Merged from https://github.com/openssl/openssl/pull/1686)
-----------------------------------------------------------------------
Summary of changes:
appveyor.yml | 2 +-
test/testlib/OpenSSL/Test.pm | 339 ++++++++++++++++++++++++++-----------------
2 files changed, 209 insertions(+), 132 deletions(-)
diff --git a/appveyor.yml b/appveyor.yml
index c668b39..1184d7d 100644
--- a/appveyor.yml
+++ b/appveyor.yml
@@ -39,7 +39,7 @@ build_script:
test_script:
- cd _build
- - nmake test
+ - nmake test V=1
- cd ..
# Fake deploy script to test installation
diff --git a/test/testlib/OpenSSL/Test.pm b/test/testlib/OpenSSL/Test.pm
index 0c3b910..4af3629 100644
--- a/test/testlib/OpenSSL/Test.pm
+++ b/test/testlib/OpenSSL/Test.pm
@@ -16,8 +16,8 @@ use Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
$VERSION = "0.8";
@ISA = qw(Exporter);
- at EXPORT = (@Test::More::EXPORT, qw(setup indir app fuzz perlapp test perltest
- run));
+ at EXPORT = (@Test::More::EXPORT, qw(setup run indir cmd app fuzz test
+ perlapp perltest));
@EXPORT_OK = (@Test::More::EXPORT_OK, qw(bldtop_dir bldtop_file
srctop_dir srctop_file
pipe with cmdstr quotify));
@@ -94,21 +94,6 @@ my %hooks = (
# Debug flag, to be set manually when needed
my $debug = 0;
-# Declare some utility functions that are defined at the end
-sub bldtop_file;
-sub bldtop_dir;
-sub srctop_file;
-sub srctop_dir;
-sub quotify;
-
-# Declare some private functions that are defined at the end
-sub __env;
-sub __cwd;
-sub __apps_file;
-sub __results_file;
-sub __fixup_cmd;
-sub __build_cmd;
-
=head2 Main functions
The following functions are exported by default when using C<OpenSSL::Test>.
@@ -218,25 +203,18 @@ sub indir {
=over 4
-=item B<app ARRAYREF, OPTS>
-
-=item B<test ARRAYREF, OPTS>
-
-Both of these functions take a reference to a list that is a command and
-its arguments, and some additional options (described further on).
-
-C<app> expects to find the given command (the first item in the given list
-reference) as an executable in C<$BIN_D> (if defined, otherwise C<$TOP/apps>
-or C<$BLDTOP/apps>).
+=item B<cmd ARRAYREF, OPTS>
-C<test> expects to find the given command (the first item in the given list
-reference) as an executable in C<$TEST_D> (if defined, otherwise C<$TOP/test>
-or C<$BLDTOP/test>).
+This functions build up a platform dependent command based on the
+input. It takes a reference to a list that is the executable or
+script and its arguments, and some additional options (described
+further on). Where necessary, the command will be wrapped in a
+suitable environment to make sure the correct shared libraries are
+used (currently only on Unix).
-Both return a CODEREF to be used by C<run>, C<pipe> or C<cmdstr>.
+It returns a CODEREF to be used by C<run>, C<pipe> or C<cmdstr>.
-The options that both C<app> and C<test> can take are in the form of hash
-values:
+The options that C<cmd> can take are in the form of hash values:
=over 4
@@ -252,21 +230,42 @@ string PATH, I<or>, if the value is C<undef>, C</dev/null> or similar.
=back
+=item B<app ARRAYREF, OPTS>
+
+=item B<test ARRAYREF, OPTS>
+
+Both of these are specific applications of C<cmd>, with just a couple
+of small difference:
+
+C<app> expects to find the given command (the first item in the given list
+reference) as an executable in C<$BIN_D> (if defined, otherwise C<$TOP/apps>
+or C<$BLDTOP/apps>).
+
+C<test> expects to find the given command (the first item in the given list
+reference) as an executable in C<$TEST_D> (if defined, otherwise C<$TOP/test>
+or C<$BLDTOP/test>).
+
+Also, for both C<app> and C<test>, the command may be prefixed with
+the content of the environment variable C<$EXE_SHELL>, which is useful
+in case OpenSSL has been cross compiled.
+
=item B<perlapp ARRAYREF, OPTS>
=item B<perltest ARRAYREF, OPTS>
-Both these functions function the same way as B<app> and B<test>, except
-that they expect the command to be a perl script. Also, they support one
-more option:
+These are also specific applications of C<cmd>, where the interpreter
+is predefined to be C<perl>, and they expect the script to be
+interpreted to reside in the same location as C<app> and C<test>.
+
+C<perlapp> and C<perltest> will also take the following option:
=over 4
=item B<interpreter_args =E<gt> ARRAYref>
-The array reference is a set of arguments for perl rather than the script.
-Take care so that none of them can be seen as a script! Flags and their
-eventual arguments only!
+The array reference is a set of arguments for the interpreter rather
+than the script. Take care so that none of them can be seen as a
+script! Flags and their eventual arguments only!
=back
@@ -277,54 +276,114 @@ An example:
=back
+=begin comment
+
+One might wonder over the complexity of C<apps>, C<fuzz>, C<test>, ...
+with all the lazy evaluations and all that. The reason for this is that
+we want to make sure the directory in which those programs are found are
+correct at the time these commands are used. Consider the following code
+snippet:
+
+ my $cmd = app(["openssl", ...]);
+
+ indir "foo", sub {
+ ok(run($cmd), "Testing foo")
+ };
+
+If there wasn't this lazy evaluation, the directory where C<openssl> is
+found would be incorrect at the time C<run> is called, because it was
+calculated before we moved into the directory "foo".
+
+=end comment
+
=cut
+sub cmd {
+ my $cmd = shift;
+ my %opts = @_;
+ return sub {
+ my $num = shift;
+ # Make a copy to not destroy the caller's array
+ my @cmdargs = ( @$cmd );
+ my @prog = __wrap_cmd(shift @cmdargs, $opts{exe_shell} // ());
+
+ return __decorate_cmd($num, [ @prog, quotify(@cmdargs) ],
+ %opts);
+ }
+}
+
sub app {
my $cmd = shift;
my %opts = @_;
- return sub { my $num = shift;
- return __build_cmd($num, \&__apps_file, $cmd, %opts); }
+ return sub {
+ my @cmdargs = ( @{$cmd} );
+ my @prog = __fixup_prg(__apps_file(shift @cmdargs, __exeext()));
+ return cmd([ @prog, @cmdargs ],
+ exe_shell => $ENV{EXE_SHELL}, %opts) -> (shift);
+ }
}
sub fuzz {
my $cmd = shift;
my %opts = @_;
- return sub { my $num = shift;
- return __build_cmd($num, \&__fuzz_file, $cmd, %opts); }
+ return sub {
+ my @cmdargs = ( @{$cmd} );
+ my @prog = __fixup_prg(__fuzz_file(shift @cmdargs, __exeext()));
+ return cmd([ @prog, @cmdargs ],
+ exe_shell => $ENV{EXE_SHELL}, %opts) -> (shift);
+ }
}
sub test {
my $cmd = shift;
my %opts = @_;
- return sub { my $num = shift;
- return __build_cmd($num, \&__test_file, $cmd, %opts); }
+ return sub {
+ my @cmdargs = ( @{$cmd} );
+ my @prog = __fixup_prg(__test_file(shift @cmdargs, __exeext()));
+ return cmd([ @prog, @cmdargs ],
+ exe_shell => $ENV{EXE_SHELL}, %opts) -> (shift);
+ }
}
sub perlapp {
my $cmd = shift;
my %opts = @_;
- return sub { my $num = shift;
- return __build_cmd($num, \&__perlapps_file, $cmd, %opts); }
+ return sub {
+ my @interpreter_args = defined $opts{interpreter_args} ?
+ @{$opts{interpreter_args}} : ();
+ my @interpreter = __fixup_prg($^X);
+ my @cmdargs = ( @{$cmd} );
+ my @prog = __apps_file(shift @cmdargs, undef);
+ return cmd([ @interpreter, @interpreter_args,
+ @prog, @cmdargs ], %opts) -> (shift);
+ }
}
sub perltest {
my $cmd = shift;
my %opts = @_;
- return sub { my $num = shift;
- return __build_cmd($num, \&__perltest_file, $cmd, %opts); }
+ return sub {
+ my @interpreter_args = defined $opts{interpreter_args} ?
+ @{$opts{interpreter_args}} : ();
+ my @interpreter = __fixup_prg($^X);
+ my @cmdargs = ( @{$cmd} );
+ my @prog = __test_file(shift @cmdargs, undef);
+ return cmd([ @interpreter, @interpreter_args,
+ @prog, @cmdargs ], %opts) -> (shift);
+ }
}
=over 4
=item B<run CODEREF, OPTS>
-This CODEREF is expected to be the value return by C<app> or C<test>,
-anything else will most likely cause an error unless you know what you're
-doing.
+CODEREF is expected to be the value return by C<cmd> or any of its
+derivatives, anything else will most likely cause an error unless you
+know what you're doing.
C<run> executes the command returned by CODEREF and return either the
-resulting output (if the option C<capture> is set true) or a boolean indicating
-if the command succeeded or not.
+resulting output (if the option C<capture> is set true) or a boolean
+indicating if the command succeeded or not.
The options that C<run> can take are in the form of hash values:
@@ -725,6 +784,14 @@ sub __env {
$end_with_bailout = $ENV{STOPTEST} ? 1 : 0;
};
+# __srctop_file and __srctop_dir are helpers to build file and directory
+# names on top of the source directory. They depend on $SRCTOP, and
+# therefore on the proper use of setup() and when needed, indir().
+# __bldtop_file and __bldtop_dir do the same thing but relative to $BLDTOP.
+# __srctop_file and __bldtop_file take the same kind of argument as
+# File::Spec::Functions::catfile.
+# Similarly, __srctop_dir and __bldtop_dir take the same kind of argument
+# as File::Spec::Functions::catdir
sub __srctop_file {
BAIL_OUT("Must run setup() first") if (! $test_name);
@@ -751,6 +818,9 @@ sub __bldtop_dir {
return catdir($directories{BLDTOP}, at _);
}
+# __exeext is a function that returns the platform dependent file extension
+# for executable binaries, or the value of the environment variable $EXE_EXT
+# if that one is defined.
sub __exeext {
my $ext = "";
if ($^O eq "VMS" ) { # VMS
@@ -761,51 +831,45 @@ sub __exeext {
return $ENV{"EXE_EXT"} || $ext;
}
+# __test_file, __apps_file and __fuzz_file return the full path to a file
+# relative to the test/, apps/ or fuzz/ directory in the build tree or the
+# source tree, depending on where the file is found. Note that when looking
+# in the build tree, the file name with an added extension is looked for, if
+# an extension is given. The intent is to look for executable binaries (in
+# the build tree) or possibly scripts (in the source tree).
+# These functions all take the same arguments as File::Spec::Functions::catfile,
+# *plus* a mandatory extension argument. This extension argument can be undef,
+# and is ignored in such a case.
sub __test_file {
BAIL_OUT("Must run setup() first") if (! $test_name);
+ my $e = pop || "";
my $f = pop;
- $f = catfile($directories{BLDTEST}, at _,$f . __exeext());
- $f = catfile($directories{SRCTEST}, at _,$f) unless -x $f;
- return $f;
-}
-
-sub __perltest_file {
- BAIL_OUT("Must run setup() first") if (! $test_name);
-
- my $f = pop;
- $f = catfile($directories{BLDTEST}, at _,$f);
+ $f = catfile($directories{BLDTEST}, at _,$f . $e);
$f = catfile($directories{SRCTEST}, at _,$f) unless -f $f;
- return ($^X, $f);
+ return $f;
}
sub __apps_file {
BAIL_OUT("Must run setup() first") if (! $test_name);
+ my $e = pop || "";
my $f = pop;
- $f = catfile($directories{BLDAPPS}, at _,$f . __exeext());
- $f = catfile($directories{SRCAPPS}, at _,$f) unless -x $f;
+ $f = catfile($directories{BLDAPPS}, at _,$f . $e);
+ $f = catfile($directories{SRCAPPS}, at _,$f) unless -f $f;
return $f;
}
sub __fuzz_file {
BAIL_OUT("Must run setup() first") if (! $test_name);
+ my $e = pop || "";
my $f = pop;
- $f = catfile($directories{BLDFUZZ}, at _,$f . __exeext());
- $f = catfile($directories{SRCFUZZ}, at _,$f) unless -x $f;
+ $f = catfile($directories{BLDFUZZ}, at _,$f . $e);
+ $f = catfile($directories{SRCFUZZ}, at _,$f) unless -f $f;
return $f;
}
-sub __perlapps_file {
- BAIL_OUT("Must run setup() first") if (! $test_name);
-
- my $f = pop;
- $f = catfile($directories{BLDAPPS}, at _,$f);
- $f = catfile($directories{SRCAPPS}, at _,$f) unless -f $f;
- return ($^X, $f);
-}
-
sub __results_file {
BAIL_OUT("Must run setup() first") if (! $test_name);
@@ -813,6 +877,16 @@ sub __results_file {
return catfile($directories{RESULTS}, at _,$f);
}
+# __cwd DIR
+# __cwd DIR, OPTS
+#
+# __cwd changes directory to DIR (string) and changes all the relative
+# entries in %directories accordingly. OPTS is an optional series of
+# 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);
my %opts = @_;
@@ -900,28 +974,51 @@ sub __cwd {
return $reverse;
}
-sub __fixup_cmd {
- my $prog = shift;
+# __wrap_cmd CMD
+# __wrap_cmd CMD, EXE_SHELL
+#
+# __wrap_cmd "wraps" CMD (string) with a beginning command that makes sure
+# the command gets executed with an appropriate environment. If EXE_SHELL
+# is given, it is used as the beginning command.
+#
+# __wrap_cmd returns a list that should be used to build up a larger list
+# of command tokens, or be joined together like this:
+#
+# join(" ", __wrap_cmd($cmd))
+sub __wrap_cmd {
+ my $cmd = shift;
my $exe_shell = shift;
- my $prefix = __bldtop_file("util", "shlib_wrap.sh")." ";
+ my @prefix = ( __bldtop_file("util", "shlib_wrap.sh") );
+
+ 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 = ();
+ }
+
+ return (@prefix, $cmd);
+}
- if (defined($exe_shell)) {
- $prefix = "$exe_shell ";
- } elsif ($^O eq "VMS" ) { # VMS
+# __fixup_prg PROG
+#
+# __fixup_prg does whatever fixup is needed to execute an executable binary
+# given by PROG (string).
+#
+# __fixup_prg returns a string with the possibly prefixed program path spec.
+sub __fixup_prg {
+ my $prog = shift;
+
+ my $prefix = "";
+
+ if ($^O eq "VMS" ) {
$prefix = ($prog =~ /^(?:[\$a-z0-9_]+:)?[<\[]/i ? "mcr " : "mcr []");
- } elsif ($^O eq "MSWin32") { # Windows
- $prefix = "";
}
- # We test both with and without extension. The reason
- # is that we might be passed a complete file spec, with
- # extension.
+ # We test if the program to use exists.
if ( ! -x $prog ) {
- my $prog = "$prog";
- if ( ! -x $prog ) {
- $prog = undef;
- }
+ $prog = undef;
}
if (defined($prog)) {
@@ -937,45 +1034,25 @@ sub __fixup_cmd {
return undef;
}
-sub __build_cmd {
+# __decorate_cmd NUM, CMDARRAYREF
+#
+# __decorate_cmd takes a command number NUM and a command token array
+# CMDARRAYREF, builds up a command string from them and decorates it
+# with necessary redirections.
+# __decorate_cmd returns a list of two strings, one with the command
+# string to actually be used, the other to be displayed for the user.
+# The reason these strings might differ is that we redirect stderr to
+# the null device unless we're verbose and unless the user has
+# explicitly specified a stderr redirection.
+sub __decorate_cmd {
BAIL_OUT("Must run setup() first") if (! $test_name);
my $num = shift;
- my $path_builder = shift;
- # Make a copy to not destroy the caller's array
- my @cmdarray = ( @{$_[0]} ); shift;
+ my $cmd = shift;
my %opts = @_;
- # We do a little dance, as $path_builder might return a list of
- # more than one. If so, only the first is to be considered a
- # program to fix up, the rest is part of the arguments. This
- # happens for perl scripts, where $path_builder will return
- # a list of two, $^X and the script name.
- # Also, if $path_builder returned more than one, we don't apply
- # the EXE_SHELL environment variable.
- my @prog = ($path_builder->(shift @cmdarray));
- my $first = shift @prog;
- my $exe_shell = @prog ? undef : $ENV{EXE_SHELL};
- my $cmd = __fixup_cmd($first, $exe_shell);
- if (@prog) {
- if ( ! -f $prog[0] ) {
- print STDERR "$prog[0] not found\n";
- $cmd = undef;
- }
- }
- my @args = (@prog, @cmdarray);
- if (defined($opts{interpreter_args})) {
- unshift @args, @{$opts{interpreter_args}};
- }
-
- return () if !$cmd;
-
- my $arg_str = "";
+ my $cmdstr = join(" ", @$cmd);
my $null = devnull();
-
-
- $arg_str = " ".join(" ", quotify @args) if @args;
-
my $fileornull = sub { $_[0] ? $_[0] : $null; };
my $stdin = "";
my $stdout = "";
@@ -985,19 +1062,19 @@ sub __build_cmd {
$stdout= " > ".$fileornull->($opts{stdout}) if exists($opts{stdout});
$stderr=" 2> ".$fileornull->($opts{stderr}) if exists($opts{stderr});
- my $display_cmd = "$cmd$arg_str$stdin$stdout$stderr";
+ my $display_cmd = "$cmdstr$stdin$stdout$stderr";
$stderr=" 2> ".$null
unless $stderr || !$ENV{HARNESS_ACTIVE} || $ENV{HARNESS_VERBOSE};
- $cmd .= "$arg_str$stdin$stdout$stderr";
+ $cmdstr .= "$stdin$stdout$stderr";
if ($debug) {
- print STDERR "DEBUG[__build_cmd]: \$cmd = \"$cmd\"\n";
- print STDERR "DEBUG[__build_cmd]: \$display_cmd = \"$display_cmd\"\n";
+ print STDERR "DEBUG[__decorate_cmd]: \$cmdstr = \"$cmdstr\"\n";
+ print STDERR "DEBUG[__decorate_cmd]: \$display_cmd = \"$display_cmd\"\n";
}
- return ($cmd, $display_cmd);
+ return ($cmdstr, $display_cmd);
}
=head1 SEE ALSO
More information about the openssl-commits
mailing list