Commit a00c84f6 authored by Richard Levitte's avatar Richard Levitte
Browse files

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: default avatarMatt Caswell <matt@openssl.org>
parent a18a31e4

test/testlib/OpenSSL/Test.pm

+77 −11
Original line number Diff line number Diff line
@@ -9,7 +9,7 @@ use Exporter; 
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);

$VERSION = "0.7";

@ISA = qw(Exporter);

@EXPORT = (@Test::More::EXPORT, qw(setup indir app test run));

@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},@_,$f);

}



sub __perltest_file {

    BAIL_OUT("Must run setup() first") if (! $test_name);



    my $f = pop;

    return ($^X, catfile($directories{TEST},@_,$f));

}



sub __apps_file {

    BAIL_OUT("Must run setup() first") if (! $test_name);
@@ -594,6 +625,13 @@ sub __apps_file { 
    return catfile($directories{APPS},@_,$f);

}



sub __perlapps_file {

    BAIL_OUT("Must run setup() first") if (! $test_name);



    my $f = pop;

    return ($^X, catfile($directories{APPS},@_,$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);

}