[openssl-commits] [openssl] master update
Richard Levitte
levitte at openssl.org
Tue Jan 26 14:58:28 UTC 2016
The branch master has been updated
via aa50e2a39d9e9ec3226d0b33feaf98198e779d47 (commit)
via a00c84f6c656cdadbaf8bec6149189ba1bd37aee (commit)
from a18a31e49d266b687f425c3c434a5aef1f719e38 (commit)
- Log -----------------------------------------------------------------
commit aa50e2a39d9e9ec3226d0b33feaf98198e779d47
Author: Richard Levitte <levitte at openssl.org>
Date: Tue Jan 26 15:01:00 2016 +0100
80-test_ca.t is made to use the new perlapp()
Reviewed-by: Matt Caswell <matt at openssl.org>
commit a00c84f6c656cdadbaf8bec6149189ba1bd37aee
Author: Richard Levitte <levitte at openssl.org>
Date: Tue Jan 26 14:57:21 2016 +0100
Have OpenSSL::Test handle perl scripts like any program
Since we're building some of our perl scripts and the result might not
end up in apps/ (*), we may need to treat them like the compile
programs we use for testing.
This introduces perlapp() and perltest(), which behave like app() and
test(), but will add the perl executable in the command line.
-----
(*) For example, with a mk1mf build, the result will end up in $(BIN_D)
Reviewed-by: Matt Caswell <matt at openssl.org>
-----------------------------------------------------------------------
Summary of changes:
test/recipes/80-test_ca.t | 17 +++------
test/testlib/OpenSSL/Test.pm | 88 ++++++++++++++++++++++++++++++++++++++------
2 files changed, 83 insertions(+), 22 deletions(-)
diff --git a/test/recipes/80-test_ca.t b/test/recipes/80-test_ca.t
index b00e303..e97a83f 100644
--- a/test/recipes/80-test_ca.t
+++ b/test/recipes/80-test_ca.t
@@ -4,40 +4,35 @@ use strict;
use warnings;
use POSIX;
-use File::Spec::Functions qw/splitdir curdir catfile devnull/;
use File::Path 2.00 qw/remove_tree/;
-use OpenSSL::Test qw/:DEFAULT cmdstr top_file quotify/;
+use OpenSSL::Test qw/:DEFAULT cmdstr top_file/;
setup("test_ca");
-my $perl = $^X;
$ENV{OPENSSL} = cmdstr(app(["openssl"]));
-my $CA_pl = top_file("apps", "CA.pl");
my $std_openssl_cnf = $^O eq "VMS"
? top_file("apps", "openssl-vms.cnf") : top_file("apps", "openssl.cnf");
-($perl) = quotify($perl) unless $^O eq "VMS"; # never quotify a command on VMS. Ever!
-
remove_tree("demoCA", { safe => 0 });
plan tests => 4;
SKIP: {
$ENV{OPENSSL_CONFIG} = "-config ".top_file("test", "CAss.cnf");
skip "failed creating CA structure", 3
- if !is(system("$perl ".$CA_pl." -newca < ".devnull()." 2>&1"), 0,
+ if !ok(run(perlapp(["CA.pl","-newca"], stdin => undef, stderr => undef)),
'creating CA structure');
$ENV{OPENSSL_CONFIG} = "-config ".top_file("test", "Uss.cnf");
skip "failed creating new certificate request", 2
- if !is(system("$perl ".$CA_pl." -newreq 2>&1"), 0,
- 'creating new certificate request');
+ if !ok(run(perlapp(["CA.pl","-newreq"], stderr => undef)),
+ 'creating CA structure');
$ENV{OPENSSL_CONFIG} = "-config ".$std_openssl_cnf;
skip "failed to sign certificate request", 1
- if !is(yes("$perl ".$CA_pl." -sign 2>&1"), 0,
+ if !is(yes(cmdstr(perlapp(["CA.pl", "-sign"], stderr => undef))), 0,
'signing certificate request');
- is(system("$perl ".$CA_pl." -verify newcert.pem 2>&1"), 0,
+ ok(run(perlapp(["CA.pl", "-verify", "newcert.pem"], stderr => undef)),
'verifying new certificate');
}
diff --git a/test/testlib/OpenSSL/Test.pm b/test/testlib/OpenSSL/Test.pm
index e4218c5..491984c 100644
--- a/test/testlib/OpenSSL/Test.pm
+++ b/test/testlib/OpenSSL/Test.pm
@@ -9,7 +9,7 @@ use Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
$VERSION = "0.7";
@ISA = qw(Exporter);
- at EXPORT = (@Test::More::EXPORT, qw(setup indir app test run));
+ at EXPORT = (@Test::More::EXPORT, qw(setup indir app perlapp test perltest run));
@EXPORT_OK = (@Test::More::EXPORT_OK, qw(top_dir top_file pipe with cmdstr
quotify));
@@ -76,6 +76,9 @@ my %hooks = (
);
+# Debug flag, to be set manually when needed
+my $debug = 0;
+
# Declare some utility functions that are defined at the end
sub top_file;
sub top_dir;
@@ -224,6 +227,13 @@ string PATH, I<or>, if the value is C<undef>, C</dev/null> or similar.
=back
+=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.
+
=back
=cut
@@ -242,6 +252,20 @@ sub test {
return __build_cmd($num, \&__test_file, $cmd, %opts); }
}
+sub perlapp {
+ my $cmd = shift;
+ my %opts = @_;
+ return sub { my $num = shift;
+ return __build_cmd($num, \&__perlapps_file, $cmd, %opts); }
+}
+
+sub perltest {
+ my $cmd = shift;
+ my %opts = @_;
+ return sub { my $num = shift;
+ return __build_cmd($num, \&__perltest_file, $cmd, %opts); }
+}
+
=over 4
=item B<run CODEREF, OPTS>
@@ -587,6 +611,13 @@ sub __test_file {
return catfile($directories{TEST}, at _,$f);
}
+sub __perltest_file {
+ BAIL_OUT("Must run setup() first") if (! $test_name);
+
+ my $f = pop;
+ return ($^X, catfile($directories{TEST}, at _,$f));
+}
+
sub __apps_file {
BAIL_OUT("Must run setup() first") if (! $test_name);
@@ -594,6 +625,13 @@ sub __apps_file {
return catfile($directories{APPS}, at _,$f);
}
+sub __perlapps_file {
+ BAIL_OUT("Must run setup() first") if (! $test_name);
+
+ my $f = pop;
+ return ($^X, catfile($directories{APPS}, at _,$f));
+}
+
sub __results_file {
BAIL_OUT("Must run setup() first") if (! $test_name);
@@ -650,7 +688,7 @@ sub __cwd {
}
}
- if (0) {
+ if ($debug) {
print STDERR "DEBUG: __cwd(), directories and files:\n";
print STDERR " \$directories{TEST} = \"$directories{TEST}\"\n";
print STDERR " \$directories{RESULTS} = \"$directories{RESULTS}\"\n";
@@ -682,13 +720,22 @@ sub __fixup_cmd {
}
# We test both with and without extension. The reason
- # is that we might, for example, be passed a Perl script
- # ending with .pl...
- my $file = "$prog$ext";
- if ( -x $file ) {
- return $prefix.$file;
- } elsif ( -f $prog ) {
- return $prog;
+ # is that we might be passed a complete file spec, with
+ # extension.
+ if ( ! -x $prog ) {
+ my $prog = "$prog$ext";
+ if ( ! -x $prog ) {
+ $prog = undef;
+ }
+ }
+
+ if (defined($prog)) {
+ # Make sure to quotify the program file on platforms that may
+ # have spaces or similar in their path name.
+ # To our knowledge, VMS is the exception where quotifying should
+ # never happem.
+ ($prog) = quotify($prog) unless $^O eq "VMS";
+ return $prefix.$prog;
}
print STDERR "$prog not found\n";
@@ -702,8 +749,22 @@ sub __build_cmd {
my $path_builder = shift;
# Make a copy to not destroy the caller's array
my @cmdarray = ( @{$_[0]} ); shift;
- my $cmd = __fixup_cmd($path_builder->(shift @cmdarray));
- my @args = @cmdarray;
+
+ # 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
+ my @prog = ($path_builder->(shift @cmdarray));
+ my $cmd = __fixup_cmd(shift @prog);
+ if (@prog) {
+ if ( ! -f $prog[0] ) {
+ print STDERR "$prog[0] not found\n";
+ $cmd = undef;
+ }
+ }
+ my @args = (@prog, @cmdarray);
+
my %opts = @_;
return () if !$cmd;
@@ -730,6 +791,11 @@ sub __build_cmd {
my $display_cmd = "$cmd$arg_str$stdin$stdout$stderr";
$cmd .= "$arg_str$stdin$stdout 2> $errlog";
+ if ($debug) {
+ print STDERR "DEBUG[__build_cmd]: \$cmd = \"$cmd\"\n";
+ print STDERR "DEBUG[__build_cmd]: \$display_cmd = \"$display_cmd\"\n";
+ }
+
return ($cmd, $display_cmd, $errlog => $saved_stderr);
}
More information about the openssl-commits
mailing list