From f5098edb14ce7da8db814dd392358d53c2b81496 Mon Sep 17 00:00:00 2001 From: Richard Levitte Date: Thu, 30 Apr 2015 14:30:15 +0200 Subject: Document OpenSSL::Test and OpenSSL::Test::Simple For OpenSSL::Test, it meant rearranging the code to better suite the structure of the documentation. Reviewed-by: Rich Salz --- test/testlib/OpenSSL/Test.pm | 711 +++++++++++++++++++++++++++--------- test/testlib/OpenSSL/Test/Simple.pm | 49 ++- 2 files changed, 577 insertions(+), 183 deletions(-) (limited to 'test/testlib') diff --git a/test/testlib/OpenSSL/Test.pm b/test/testlib/OpenSSL/Test.pm index 8b9ddbe..83d7acc 100644 --- a/test/testlib/OpenSSL/Test.pm +++ b/test/testlib/OpenSSL/Test.pm @@ -7,131 +7,112 @@ use Test::More 0.96; use Exporter; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); -$VERSION = "0.5"; +$VERSION = "0.7"; @ISA = qw(Exporter); @EXPORT = (@Test::More::EXPORT, qw(setup indir app test run)); @EXPORT_OK = (@Test::More::EXPORT_OK, qw(top_dir top_file pipe with cmdstr quotify)); +=head1 NAME -use File::Copy; -use File::Spec::Functions qw/file_name_is_absolute curdir canonpath splitdir - catdir catfile splitpath catpath devnull abs2rel - rel2abs/; -use File::Path 2.00 qw/remove_tree mkpath/; +OpenSSL::Test - a private extension of Test::More +=head1 SYNOPSIS -my $test_name = undef; + use OpenSSL::Test; -my %directories = (); # Directories we want to keep track of - # TOP, APPS, TEST and RESULTS are the - # ones we're interested in, corresponding - # to the environment variables TOP (mandatory), - # BIN_D, TEST_D and RESULT_D. + setup("my_test_name"); -my $end_with_bailout = 0; + ok(run(app(["openssl", "version"])), "check for openssl presence"); -sub quotify; + indir "subdir" => sub { + ok(run(test(["sometest", "arg1"], stdout => "foo.txt")), + "run sometest with output to foo.txt"); + }; -sub __top_file { - BAIL_OUT("Must run setup() first") if (! $test_name); +=head1 DESCRIPTION - my $f = pop; - return catfile($directories{TOP},@_,$f); -} +This module is a private extension of L for testing OpenSSL. +In addition to the Test::More functions, it also provides functions that +easily find the diverse programs within a OpenSSL build tree, as well as +some other useful functions. -sub __test_file { - BAIL_OUT("Must run setup() first") if (! $test_name); +This module I on the environment variable C<$TOP>. Without it, +it refuses to work. See L below. - my $f = pop; - return catfile($directories{TEST},@_,$f); -} +=cut -sub __apps_file { - BAIL_OUT("Must run setup() first") if (! $test_name); +use File::Copy; +use File::Spec::Functions qw/file_name_is_absolute curdir canonpath splitdir + catdir catfile splitpath catpath devnull abs2rel + rel2abs/; +use File::Path 2.00 qw/remove_tree mkpath/; - my $f = pop; - return catfile($directories{APPS},@_,$f); -} -sub __results_file { - BAIL_OUT("Must run setup() first") if (! $test_name); +# The name of the test. This is set by setup() and is used in the other +# functions to verify that setup() has been used. +my $test_name = undef; - my $f = pop; - return catfile($directories{RESULTS},@_,$f); -} +# Directories we want to keep track of TOP, APPS, TEST and RESULTS are the +# ones we're interested in, corresponding to the environment variables TOP +# (mandatory), BIN_D, TEST_D and RESULT_D. +my %directories = (); -sub __test_log { - return __results_file("$test_name.log"); -} +# 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. +my $end_with_bailout = 0; -sub top_dir { - return __top_file(@_, ""); # This caters for operating systems that have - # a very distinct syntax for directories. -} -sub top_file { - return __top_file(@_); -} +# A set of hooks that is affected by with() and may be used in diverse places. +# All hooks are expected to be CODE references. +my %hooks = ( -sub __cwd { - my $dir = shift; - my %opts = @_; - my $abscurdir = rel2abs(curdir()); - my $absdir = rel2abs($dir); - my $reverse = abs2rel($abscurdir, $absdir); + # exit_checker is used by run() directly after completion of a command. + # it receives the exit code from that command and is expected to return + # 1 (for success) or 0 (for failure). This is the value that will be + # returned by run(). + # NOTE: When run() gets the option 'capture => 1', this hook is ignored. + exit_checker => sub { return shift == 0 ? 1 : 0 }, - # PARANOIA: if we're not moving anywhere, we do nothing more - if ($abscurdir eq $absdir) { - return $reverse; - } + ); - # Do not support a move to a different volume for now. Maybe later. - BAIL_OUT("FAILURE: \"$dir\" moves to a different volume, not supported") - if $reverse eq $abscurdir; +# Declare some utility functions that are defined at the end +sub top_file; +sub top_dir; +sub quotify; - # If someone happened to give a directory that leads back to the current, - # it's extremely silly to do anything more, so just simulate that we did - # move. - # In this case, we won't even clean it out, for safety's sake. - return "." if $reverse eq ""; +# Declare some private functions that are defined at the end +sub __env; +sub __cwd; +sub __apps_file; +sub __results_file; +sub __test_log; +sub __cwd; +sub __fixup_cmd; +sub __build_cmd; - $dir = canonpath($dir); - if ($opts{create}) { - mkpath($dir); - } +=head2 Main functions - # Should we just bail out here as well? I'm unsure. - return undef unless chdir($dir); +The following functions are exported by default when using C. - if ($opts{cleanup}) { - remove_tree(".", { safe => 0, keep_root => 1 }); - } +=cut - # For each of these directory variables, figure out where they are relative - # to the directory we want to move to if they aren't absolute (if they are, - # they don't change!) - my @dirtags = ("TOP", "TEST", "APPS", "RESULTS"); - foreach (@dirtags) { - if (!file_name_is_absolute($directories{$_})) { - my $newpath = abs2rel(rel2abs($directories{$_}), rel2abs($dir)); - $directories{$_} = $newpath; - } - } +=over 4 - if (0) { - print STDERR "DEBUG: __cwd(), directories and files:\n"; - print STDERR " \$directories{TEST} = \"$directories{TEST}\"\n"; - print STDERR " \$directories{RESULTS} = \"$directories{RESULTS}\"\n"; - print STDERR " \$directories{APPS} = \"$directories{APPS}\"\n"; - print STDERR " \$directories{TOP} = \"$directories{TOP}\"\n"; - print STDERR " \$test_log = \"",__test_log(),"\"\n"; - print STDERR "\n"; - print STDERR " current directory is \"",curdir(),"\"\n"; - print STDERR " the way back is \"$reverse\"\n"; - } +=item B - return $reverse; -} +C is used for initial setup, and it is mandatory that it's used. +If it's not used in a OpenSSL test recipe, the rest of the recipe will +most likely refuse to run. + +C checks for environment variables (see L below), +check that C<$TOP/Configure> exists, C into the results directory +(defined by the C<$RESULT_D> environment variable if defined, otherwise +C<$TEST_D> if defined, otherwise C<$TOP/test>). + +=back + +=cut sub setup { $test_name = shift; @@ -139,12 +120,7 @@ sub setup { BAIL_OUT("setup() must receive a name") unless $test_name; BAIL_OUT("setup() needs \$TOP to be defined") unless $ENV{TOP}; - $directories{TOP} = $ENV{TOP}, - $directories{APPS} = $ENV{BIN_D} || catdir($directories{TOP},"apps"); - $directories{TEST} = $ENV{TEST_D} || catdir($directories{TOP},"test"); - $directories{RESULTS} = $ENV{RESULT_D} || $directories{TEST}; - - $end_with_bailout = $ENV{STOPTEST} ? 1 : 0; + __env(); BAIL_OUT("setup() expects the file Configure in the \$TOP directory") unless -f top_file("Configure"); @@ -155,6 +131,48 @@ sub setup { 1 while unlink(__test_log()); } +=over 4 + +=item B sub BLOCK, OPTS> + +C is used to run a part of the recipe in a different directory than +the one C moved into, usually a subdirectory, given by SUBDIR. +The part of the recipe that's run there is given by the codeblock BLOCK. + +C takes some additional options OPTS that affect the subdirectory: + +=over 4 + +=item B 0|1> + +When set to 1 (or any value that perl preceives as true), the subdirectory +will be created if it doesn't already exist. This happens before BLOCK +is executed. + +=item B 0|1> + +When set to 1 (or any value that perl preceives as true), the subdirectory +will be cleaned out and removed. This happens both before and after BLOCK +is executed. + +=back + +An example: + + indir "foo" => sub { + ok(run(app(["openssl", "version"]), stdout => "foo.txt")); + if (ok(open(RESULT, "foo.txt"), "reading foo.txt")) { + my $line = ; + close RESULT; + is($line, qr/^OpenSSL 1\./, + "check that we're using OpenSSL 1.x.x"); + } + }, create => 1, cleanup => 1; + +=back + +=cut + sub indir { my $subdir = shift; my $codeblock = shift; @@ -173,91 +191,43 @@ sub indir { } } -my %hooks = ( - exit_checker => sub { return shift == 0 ? 1 : 0 } - ); +=over 4 -sub with { - my $opts = shift; - my %opts = %{$opts}; - my $codeblock = shift; +=item B - my %saved_hooks = (); +=item B - foreach (keys %opts) { - $saved_hooks{$_} = $hooks{$_} if exists($hooks{$_}); - $hooks{$_} = $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). - $codeblock->(); - - foreach (keys %saved_hooks) { - $hooks{$_} = $saved_hooks{$_}; - } -} +C 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>). -sub __fixup_cmd { - my $prog = shift; +C 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>). - my $prefix = __top_file("util", "shlib_wrap.sh")." "; - my $ext = $ENV{"EXE_EXT"} || ""; +Both return a CODEREF to be used by C, C or C. - if ( $^O eq "VMS" ) { # VMS - $prefix = "mcr "; - $ext = ".exe"; - } elsif ($^O eq "MSWin32") { # Windows - $prefix = ""; - $ext = ".exe"; - } +The options that both C and C can take are in the form of hash +values: - # 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; - } +=over 4 - print STDERR "$prog not found\n"; - return undef; -} +=item B PATH> -sub __build_cmd { - BAIL_OUT("Must run setup() first") if (! $test_name); +=item B PATH> - my $num = shift; - my $path_builder = shift; - my $cmd = __fixup_cmd($path_builder->(shift @{$_[0]})); - my @args = @{$_[0]}; shift; - my %opts = @_; +=item B PATH> - return () if !$cmd; +In all three cases, the corresponding standard input, output or error is +redirected from (for stdin) or to (for the others) a file given by the +string PATH, I, if the value is C, C or similar. - my $arg_str = ""; - my $null = devnull(); +=back +=back - $arg_str = " ".join(" ", quotify @args) if @args; - - my $fileornull = sub { $_[0] ? $_[0] : $null; }; - my $stdin = ""; - my $stdout = ""; - my $stderr = ""; - my $saved_stderr = undef; - $stdin = " < ".$fileornull->($opts{stdin}) if exists($opts{stdin}); - $stdout= " > ".$fileornull->($opts{stdout}) if exists($opts{stdout}); - $stderr=" 2> ".$fileornull->($opts{stderr}) if exists($opts{stderr}); - - $saved_stderr = $opts{stderr} if defined($opts{stderr}); - - my $errlog = $num ? "$test_name.$num.tmp_err" : "$test_name.tmp_err"; - my $display_cmd = "$cmd$arg_str$stdin$stdout$stderr"; - $cmd .= "$arg_str$stdin$stdout 2> $errlog"; - - return ($cmd, $display_cmd, $errlog => $saved_stderr); -} +=cut sub app { my $cmd = shift; @@ -273,19 +243,38 @@ sub test { return __build_cmd($num, \&__test_file, $cmd, %opts); } } -sub cmdstr { - my ($cmd, $display_cmd, %errlogs) = shift->(0); +=over 4 - return $display_cmd; -} +=item B + +This CODEREF is expected to be the value return by C or C, +anything else will most likely cause an error unless you know what you're +doing. + +C executes the command returned by CODEREF and return either the +resulting output (if the option C is set true) or a boolean indicating +if the command succeeded or not. + +The options that C can take are in the form of hash values: + +=over 4 + +=item B 0|1> + +If true, the command will be executed with a perl backtick, and C will +return the resulting output as an array of lines. If false or not given, +the command will be executed with C, and C will return 1 if +the command was successful or 0 if it wasn't. + +=back + +For further discussion on what is considered a successful command or not, see +the function C further down. + +=back + +=cut -END { - my $tb = Test::More->builder; - my $failure = scalar(grep { $_ == 0; } $tb->summary); - if ($failure && $end_with_bailout) { - BAIL_OUT("Stoptest!"); - } -} sub run { my ($cmd, $display_cmd, %errlogs) = shift->(0); my %opts = @_; @@ -332,6 +321,77 @@ sub run { } } +END { + my $tb = Test::More->builder; + my $failure = scalar(grep { $_ == 0; } $tb->summary); + if ($failure && $end_with_bailout) { + BAIL_OUT("Stoptest!"); + } +} + +=head2 Utility functions + +The following functions are exported on request when using C. + + # To only get the top_file function. + use OpenSSL::Test qw/top_file/; + + # To only get the top_file function in addition to the default ones. + use OpenSSL::Test qw/:DEFAULT top_file/; + +=cut + +# Utility functions, exported on request + +=over 4 + +=item B + +LIST is a list of directories that make up a path from the top of the OpenSSL +source directory (as indicated by the environment variable C<$TOP>). +C returns the resulting directory as a string, adapted to the local +operating system. + +=back + +=cut + +sub top_dir { + return __top_file(@_, ""); # This caters for operating systems that have + # a very distinct syntax for directories. +} + +=over 4 + +=item B + +LIST is a list of directories that make up a path from the top of the OpenSSL +source directory (as indicated by the environment variable C<$TOP>) and +FILENAME is the name of a file located in that directory path. +C returns the resulting file path as a string, adapted to the local +operating system. + +=back + +=cut + +sub top_file { + return __top_file(@_); +} + +=over 4 + +=item B + +LIST is a list of CODEREFs returned by C or C, from which C +creates a new command composed of all the given commands put together in a +pipe. C returns a new CODEREF in the same manner as C or C, +to be passed to C for execution. + +=back + +=cut + sub pipe { my @cmds = @_; return @@ -357,7 +417,80 @@ sub pipe { }; } -# Utility functions, some of which are exported on request +=over 4 + +=item B + +C will temporarly install hooks given by the HASHREF and then execute +the given CODEREF. Hooks are usually expected to have a coderef as value. + +The currently available hoosk are: + +=over 4 + +=item B CODEREF> + +This hook is executed after C has performed its given command. The +CODEREF receives the exit code as only argument and is expected to return +1 (if the exit code indicated success) or 0 (if the exit code indicated +failure). + +=back + +=back + +=cut + +sub with { + my $opts = shift; + my %opts = %{$opts}; + my $codeblock = shift; + + my %saved_hooks = (); + + foreach (keys %opts) { + $saved_hooks{$_} = $hooks{$_} if exists($hooks{$_}); + $hooks{$_} = $opts{$_}; + } + + $codeblock->(); + + foreach (keys %saved_hooks) { + $hooks{$_} = $saved_hooks{$_}; + } +} + +=over 4 + +=item B + +C takes a CODEREF from C or C and simply returns the +command as a string. + +=back + +=cut + +sub cmdstr { + my ($cmd, $display_cmd, %errlogs) = shift->(0); + + return $display_cmd; +} + +=over 4 + +=item B + +LIST is a list of strings that are going to be used as arguments for a +command, and makes sure to inject quotes and escapes as necessary depending +on the content of each string. + +This can also be used to put quotes around the executable of a command. +I + +=back + +=cut sub quotify { # Unix setup (default if nothing else is mentioned) @@ -389,4 +522,218 @@ sub quotify { return map { $arg_formatter->($_) } @_; } +###################################################################### +# private functions. These are never exported. + +=head1 ENVIRONMENT + +OpenSSL::Test depends on some environment variables. + +=over 4 + +=item B + +This environment variable is mandatory. C will check that it's +defined and that it's a directory that contains the file C. +If this isn't so, C will C. + +=item B + +If defined, its value should be the directory where the openssl application +is located. Defaults to C<$TOP/apps> (adapted to the operating system). + +=item B + +If defined, its value should be the directory where the test applications +are located. Defaults to C<$TOP/test> (adapted to the operating system). + +=item B + +If defined, its value should be the directory where the log files are +located. Defaults to C<$TEST_D>. + +=item B + +If defined, it puts testing in a different mode, where a recipe with +failures will result in a C at the end of its run. + +=back + +=cut + +sub __env { + $directories{TOP} = $ENV{TOP}, + $directories{APPS} = $ENV{BIN_D} || catdir($directories{TOP},"apps"); + $directories{TEST} = $ENV{TEST_D} || catdir($directories{TOP},"test"); + $directories{RESULTS} = $ENV{RESULT_D} || $directories{TEST}; + + $end_with_bailout = $ENV{STOPTEST} ? 1 : 0; +}; + +sub __top_file { + BAIL_OUT("Must run setup() first") if (! $test_name); + + my $f = pop; + return catfile($directories{TOP},@_,$f); +} + +sub __test_file { + BAIL_OUT("Must run setup() first") if (! $test_name); + + my $f = pop; + return catfile($directories{TEST},@_,$f); +} + +sub __apps_file { + BAIL_OUT("Must run setup() first") if (! $test_name); + + my $f = pop; + return catfile($directories{APPS},@_,$f); +} + +sub __results_file { + BAIL_OUT("Must run setup() first") if (! $test_name); + + my $f = pop; + return catfile($directories{RESULTS},@_,$f); +} + +sub __test_log { + return __results_file("$test_name.log"); +} + +sub __cwd { + my $dir = shift; + my %opts = @_; + my $abscurdir = rel2abs(curdir()); + my $absdir = rel2abs($dir); + my $reverse = abs2rel($abscurdir, $absdir); + + # PARANOIA: if we're not moving anywhere, we do nothing more + if ($abscurdir eq $absdir) { + return $reverse; + } + + # Do not support a move to a different volume for now. Maybe later. + BAIL_OUT("FAILURE: \"$dir\" moves to a different volume, not supported") + if $reverse eq $abscurdir; + + # If someone happened to give a directory that leads back to the current, + # it's extremely silly to do anything more, so just simulate that we did + # move. + # In this case, we won't even clean it out, for safety's sake. + return "." if $reverse eq ""; + + $dir = canonpath($dir); + if ($opts{create}) { + mkpath($dir); + } + + # Should we just bail out here as well? I'm unsure. + return undef unless chdir($dir); + + if ($opts{cleanup}) { + remove_tree(".", { safe => 0, keep_root => 1 }); + } + + # For each of these directory variables, figure out where they are relative + # to the directory we want to move to if they aren't absolute (if they are, + # they don't change!) + my @dirtags = ("TOP", "TEST", "APPS", "RESULTS"); + foreach (@dirtags) { + if (!file_name_is_absolute($directories{$_})) { + my $newpath = abs2rel(rel2abs($directories{$_}), rel2abs($dir)); + $directories{$_} = $newpath; + } + } + + if (0) { + print STDERR "DEBUG: __cwd(), directories and files:\n"; + print STDERR " \$directories{TEST} = \"$directories{TEST}\"\n"; + print STDERR " \$directories{RESULTS} = \"$directories{RESULTS}\"\n"; + print STDERR " \$directories{APPS} = \"$directories{APPS}\"\n"; + print STDERR " \$directories{TOP} = \"$directories{TOP}\"\n"; + print STDERR " \$test_log = \"",__test_log(),"\"\n"; + print STDERR "\n"; + print STDERR " current directory is \"",curdir(),"\"\n"; + print STDERR " the way back is \"$reverse\"\n"; + } + + return $reverse; +} + +sub __fixup_cmd { + my $prog = shift; + + my $prefix = __top_file("util", "shlib_wrap.sh")." "; + my $ext = $ENV{"EXE_EXT"} || ""; + + if ( $^O eq "VMS" ) { # VMS + $prefix = "mcr "; + $ext = ".exe"; + } elsif ($^O eq "MSWin32") { # Windows + $prefix = ""; + $ext = ".exe"; + } + + # 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; + } + + print STDERR "$prog not found\n"; + return undef; +} + +sub __build_cmd { + BAIL_OUT("Must run setup() first") if (! $test_name); + + my $num = shift; + my $path_builder = shift; + my $cmd = __fixup_cmd($path_builder->(shift @{$_[0]})); + my @args = @{$_[0]}; shift; + my %opts = @_; + + return () if !$cmd; + + my $arg_str = ""; + my $null = devnull(); + + + $arg_str = " ".join(" ", quotify @args) if @args; + + my $fileornull = sub { $_[0] ? $_[0] : $null; }; + my $stdin = ""; + my $stdout = ""; + my $stderr = ""; + my $saved_stderr = undef; + $stdin = " < ".$fileornull->($opts{stdin}) if exists($opts{stdin}); + $stdout= " > ".$fileornull->($opts{stdout}) if exists($opts{stdout}); + $stderr=" 2> ".$fileornull->($opts{stderr}) if exists($opts{stderr}); + + $saved_stderr = $opts{stderr} if defined($opts{stderr}); + + my $errlog = $num ? "$test_name.$num.tmp_err" : "$test_name.tmp_err"; + my $display_cmd = "$cmd$arg_str$stdin$stdout$stderr"; + $cmd .= "$arg_str$stdin$stdout 2> $errlog"; + + return ($cmd, $display_cmd, $errlog => $saved_stderr); +} + +=head1 SEE ALSO + +L, L + +=head1 AUTHORS + +Richard Levitte Elevitte@openssl.orgE with assitance and +inspiration from Andy Polyakov Eappro@openssl.org. + +=cut + 1; diff --git a/test/testlib/OpenSSL/Test/Simple.pm b/test/testlib/OpenSSL/Test/Simple.pm index 145778e..874a156 100644 --- a/test/testlib/OpenSSL/Test/Simple.pm +++ b/test/testlib/OpenSSL/Test/Simple.pm @@ -5,13 +5,47 @@ use warnings; use Exporter; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); -$VERSION = "0.1"; +$VERSION = "0.2"; @ISA = qw(Exporter); @EXPORT = qw(simple_test); +=head1 NAME + +OpenSSL::Test::Simple - a few very simple test functions + +=head1 SYNOPSIS + + use OpenSSL::Test::Simple; + + simple_test("my_test_name", "des", "destest"); + +=head1 DESCRIPTION + +Sometimes, the functions in L are quite tedious for some +repetitive tasks. This module provides functions to make life easier. +You could call them hacks if you wish. + +=cut use OpenSSL::Test; +=over 4 + +=item B + +Runs a test named NAME, running the program PROGRAM with no arguments, +to test the algorithm ALGORITHM. + +A complete recipe looks like this: + + use OpenSSL::Test::Simple; + + simple_test("test_bf", "bftest", "bf"); + +=back + +=cut + # args: # name (used with setup()) # algorithm (used to check if it's at all supported) @@ -29,3 +63,16 @@ sub simple_test { ok(run(test([$prgr])), "running $prgr"); } } + +=head1 SEE ALSO + +L + +=head1 AUTHORS + +Richard Levitte Elevitte@openssl.orgE with inspiration +from Rich Salz Ersalz@openssl.org. + +=cut + +1; -- cgit v1.1