New upstream version 2.3
This commit is contained in:
parent
c845af032a
commit
5c6ba24b61
129 changed files with 14313 additions and 2999 deletions
242
NPTest.pm
242
NPTest.pm
|
|
@ -53,8 +53,8 @@ developer to interactively request test parameter information from the
|
|||
user. The user can accept the developer's default value or reply "none"
|
||||
which will then be returned as "" for the test to skip if appropriate.
|
||||
|
||||
If a parameter needs to be entered and the test is run without a tty
|
||||
attached (such as a cronjob), the parameter will be assigned as if it
|
||||
If a parameter needs to be entered and the test is run without a tty
|
||||
attached (such as a cronjob), the parameter will be assigned as if it
|
||||
was "none". Tests can check for the parameter and skip if not set.
|
||||
|
||||
Responses are stored in an external, file-based cache so subsequent test
|
||||
|
|
@ -62,17 +62,6 @@ runs will use these values. The user is able to change the values by
|
|||
amending the values in the file /var/tmp/NPTest.cache, or by setting
|
||||
the appropriate environment variable before running the test.
|
||||
|
||||
The option exists to store parameters in a scoped means, allowing a
|
||||
test harness to a localise a parameter should the need arise. This
|
||||
allows a parameter of the same name to exist in a test harness
|
||||
specific scope, while not affecting the globally scoped parameter. The
|
||||
scoping identifier is the name of the test harness sans the trailing
|
||||
".t". All cache searches first look to a scoped parameter before
|
||||
looking for the parameter at global scope. Thus for a test harness
|
||||
called "check_disk.t" requesting the parameter "mountpoint_valid", the
|
||||
cache is first searched for "check_disk"/"mountpoint_valid", if this
|
||||
fails, then a search is conducted for "mountpoint_valid".
|
||||
|
||||
To facilitate quick testing setup, it is possible to accept all the
|
||||
developer provided defaults by setting the environment variable
|
||||
"NPTEST_ACCEPTDEFAULT" to "1" (or any other perl truth value). Note
|
||||
|
|
@ -249,26 +238,26 @@ sub checkCmd
|
|||
{
|
||||
if ( scalar( grep { $_ == $exitStatus } @{$desiredExitStatus} ) )
|
||||
{
|
||||
$desiredExitStatus = $exitStatus;
|
||||
$desiredExitStatus = $exitStatus;
|
||||
}
|
||||
else
|
||||
{
|
||||
$desiredExitStatus = -1;
|
||||
$desiredExitStatus = -1;
|
||||
}
|
||||
}
|
||||
elsif ( ref $desiredExitStatus eq "HASH" )
|
||||
{
|
||||
if ( exists( ${$desiredExitStatus}{$exitStatus} ) )
|
||||
{
|
||||
if ( defined( ${$desiredExitStatus}{$exitStatus} ) )
|
||||
{
|
||||
$testOutput = ${$desiredExitStatus}{$exitStatus};
|
||||
}
|
||||
$desiredExitStatus = $exitStatus;
|
||||
if ( defined( ${$desiredExitStatus}{$exitStatus} ) )
|
||||
{
|
||||
$testOutput = ${$desiredExitStatus}{$exitStatus};
|
||||
}
|
||||
$desiredExitStatus = $exitStatus;
|
||||
}
|
||||
else
|
||||
{
|
||||
$desiredExitStatus = -1;
|
||||
$desiredExitStatus = -1;
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -327,78 +316,51 @@ sub skipMsg
|
|||
return $testStatus;
|
||||
}
|
||||
|
||||
sub getTestParameter
|
||||
{
|
||||
my( $param, $envvar, $default, $brief, $scoped );
|
||||
my $new_style;
|
||||
if (scalar @_ <= 3) {
|
||||
($param, $brief, $default) = @_;
|
||||
$envvar = $param;
|
||||
$new_style = 1;
|
||||
} else {
|
||||
( $param, $envvar, $default, $brief, $scoped ) = @_;
|
||||
$new_style = 0;
|
||||
sub getTestParameter {
|
||||
my($param, $description, $default) = @_;
|
||||
|
||||
if($param !~ m/^NP_[A-Z0-9_]+$/mx) {
|
||||
die("parameter should be all uppercase and start with NP_ (requested from ".(caller(0))[1].")");
|
||||
}
|
||||
|
||||
# Apply default values for optional arguments
|
||||
$scoped = ( defined( $scoped ) && $scoped );
|
||||
return $ENV{$param} if $ENV{$param};
|
||||
|
||||
my $testharness = basename( (caller(0))[1], ".t" ); # used for scoping
|
||||
|
||||
if ( defined( $envvar ) && exists( $ENV{$envvar} ) && $ENV{$envvar} )
|
||||
{
|
||||
return $ENV{$envvar};
|
||||
}
|
||||
|
||||
my $cachedValue = SearchCache( $param, $testharness );
|
||||
if ( defined( $cachedValue ) )
|
||||
{
|
||||
# This save required to convert to new style because the key required is
|
||||
# changing to the environment variable
|
||||
if ($new_style == 0) {
|
||||
SetCacheParameter( $envvar, undef, $cachedValue );
|
||||
}
|
||||
my $cachedValue = SearchCache($param);
|
||||
if(defined $cachedValue) {
|
||||
return $cachedValue;
|
||||
}
|
||||
|
||||
my $defaultValid = ( defined( $default ) && $default );
|
||||
my $autoAcceptDefault = ( exists( $ENV{'NPTEST_ACCEPTDEFAULT'} ) && $ENV{'NPTEST_ACCEPTDEFAULT'} );
|
||||
|
||||
if ( $autoAcceptDefault && $defaultValid )
|
||||
{
|
||||
return $default;
|
||||
if($ENV{'NPTEST_ACCEPTDEFAULT'}) {
|
||||
return $default if $default;
|
||||
return "";
|
||||
}
|
||||
|
||||
# Set "none" if no terminal attached (eg, tinderbox build servers when new variables set)
|
||||
return "" unless (-t STDIN);
|
||||
|
||||
my $userResponse = "";
|
||||
|
||||
while ( $userResponse eq "" )
|
||||
{
|
||||
while($userResponse eq "") {
|
||||
print STDERR "\n";
|
||||
print STDERR "Test Harness : $testharness\n";
|
||||
print STDERR "Test Parameter : $param\n";
|
||||
print STDERR "Environment Variable : $envvar\n" if ($param ne $envvar);
|
||||
print STDERR "Brief Description : $brief\n";
|
||||
print STDERR "Enter value (or 'none') ", ($defaultValid ? "[${default}]" : "[]"), " => ";
|
||||
print STDERR "Test File : ".(caller(0))[1]."\n";
|
||||
print STDERR "Test Parameter : $param\n";
|
||||
print STDERR "Description : $description\n";
|
||||
print STDERR "Enter value (or 'none') ", ($default ? "[${default}]" : "[]"), " => ";
|
||||
$userResponse = <STDIN>;
|
||||
$userResponse = "" if ! defined( $userResponse ); # Handle EOF
|
||||
chomp( $userResponse );
|
||||
if ( $defaultValid && $userResponse eq "" )
|
||||
{
|
||||
chomp($userResponse);
|
||||
if($default && $userResponse eq "") {
|
||||
$userResponse = $default;
|
||||
}
|
||||
}
|
||||
|
||||
print STDERR "\n";
|
||||
|
||||
if ($userResponse =~ /^(na|none)$/) {
|
||||
$userResponse = "";
|
||||
if($userResponse =~ /^(na|none)$/) {
|
||||
$userResponse = "";
|
||||
}
|
||||
|
||||
# define all user responses at global scope
|
||||
SetCacheParameter( $param, ( $scoped ? $testharness : undef ), $userResponse );
|
||||
# store user responses
|
||||
SetCacheParameter($param, $userResponse);
|
||||
|
||||
return $userResponse;
|
||||
}
|
||||
|
|
@ -407,37 +369,20 @@ sub getTestParameter
|
|||
# Internal Cache Management Functions
|
||||
#
|
||||
|
||||
sub SearchCache
|
||||
{
|
||||
my( $param, $scope ) = @_;
|
||||
sub SearchCache {
|
||||
my($param) = @_;
|
||||
|
||||
LoadCache();
|
||||
|
||||
if ( exists( $CACHE{$scope} ) && exists( $CACHE{$scope}{$param} ) )
|
||||
{
|
||||
return $CACHE{$scope}{$param};
|
||||
}
|
||||
|
||||
if ( exists( $CACHE{$param} ) )
|
||||
{
|
||||
if(exists $CACHE{$param}) {
|
||||
return $CACHE{$param};
|
||||
}
|
||||
return undef; # Need this to say "nothing found"
|
||||
return undef; # Need this to say "nothing found"
|
||||
}
|
||||
|
||||
sub SetCacheParameter
|
||||
{
|
||||
my( $param, $scope, $value ) = @_;
|
||||
|
||||
if ( defined( $scope ) )
|
||||
{
|
||||
$CACHE{$scope}{$param} = $value;
|
||||
}
|
||||
else
|
||||
{
|
||||
$CACHE{$param} = $value;
|
||||
}
|
||||
|
||||
sub SetCacheParameter {
|
||||
my($param, $value) = @_;
|
||||
$CACHE{$param} = $value;
|
||||
SaveCache();
|
||||
}
|
||||
|
||||
|
|
@ -475,6 +420,11 @@ sub SaveCache
|
|||
delete $CACHE{'_cache_loaded_'};
|
||||
my $oldFileContents = delete $CACHE{'_original_cache'};
|
||||
|
||||
# clean up old style params
|
||||
for my $key (keys %CACHE) {
|
||||
delete $CACHE{$key} if $key !~ m/^NP_[A-Z0-9_]+$/mx;
|
||||
}
|
||||
|
||||
my($dataDumper) = new Data::Dumper([\%CACHE]);
|
||||
$dataDumper->Terse(1);
|
||||
$dataDumper->Sortkeys(1);
|
||||
|
|
@ -486,7 +436,7 @@ sub SaveCache
|
|||
if($oldFileContents ne $data) {
|
||||
my($fileHandle) = new IO::File;
|
||||
if (!$fileHandle->open( "> ${CACHEFILENAME}")) {
|
||||
print STDERR "NPTest::LoadCache() : Problem saving ${CACHEFILENAME} : $!\n";
|
||||
print STDERR "NPTest::SaveCache() : Problem saving ${CACHEFILENAME} : $!\n";
|
||||
return;
|
||||
}
|
||||
print $fileHandle $data;
|
||||
|
|
@ -542,10 +492,10 @@ sub DetermineTestHarnessDirectory
|
|||
push ( @dirs, "./tests");
|
||||
}
|
||||
|
||||
if ( @dirs > 0 )
|
||||
{
|
||||
return @dirs;
|
||||
}
|
||||
if ( @dirs > 0 )
|
||||
{
|
||||
return @dirs;
|
||||
}
|
||||
|
||||
# To be honest I don't understand which case satisfies the
|
||||
# original code in test.pl : when $tstdir == `pwd` w.r.t.
|
||||
|
|
@ -611,73 +561,73 @@ sub TestsFrom
|
|||
|
||||
# All the new object oriented stuff below
|
||||
|
||||
sub new {
|
||||
my $type = shift;
|
||||
my $self = {};
|
||||
return bless $self, $type;
|
||||
sub new {
|
||||
my $type = shift;
|
||||
my $self = {};
|
||||
return bless $self, $type;
|
||||
}
|
||||
|
||||
# Accessors
|
||||
sub return_code {
|
||||
my $self = shift;
|
||||
if (@_) {
|
||||
return $self->{return_code} = shift;
|
||||
} else {
|
||||
return $self->{return_code};
|
||||
}
|
||||
my $self = shift;
|
||||
if (@_) {
|
||||
return $self->{return_code} = shift;
|
||||
} else {
|
||||
return $self->{return_code};
|
||||
}
|
||||
}
|
||||
sub output {
|
||||
my $self = shift;
|
||||
if (@_) {
|
||||
return $self->{output} = shift;
|
||||
} else {
|
||||
return $self->{output};
|
||||
}
|
||||
my $self = shift;
|
||||
if (@_) {
|
||||
return $self->{output} = shift;
|
||||
} else {
|
||||
return $self->{output};
|
||||
}
|
||||
}
|
||||
|
||||
sub perf_output {
|
||||
my $self = shift;
|
||||
$_ = $self->{output};
|
||||
/\|(.*)$/;
|
||||
return $1 || "";
|
||||
my $self = shift;
|
||||
$_ = $self->{output};
|
||||
/\|(.*)$/;
|
||||
return $1 || "";
|
||||
}
|
||||
|
||||
sub only_output {
|
||||
my $self = shift;
|
||||
$_ = $self->{output};
|
||||
/(.*?)\|/;
|
||||
return $1 || "";
|
||||
my $self = shift;
|
||||
$_ = $self->{output};
|
||||
/(.*?)\|/;
|
||||
return $1 || "";
|
||||
}
|
||||
|
||||
sub testCmd {
|
||||
my $class = shift;
|
||||
my $command = shift or die "No command passed to testCmd";
|
||||
my $timeout = shift || 120;
|
||||
my $object = $class->new;
|
||||
my $class = shift;
|
||||
my $command = shift or die "No command passed to testCmd";
|
||||
my $timeout = shift || 120;
|
||||
my $object = $class->new;
|
||||
|
||||
local $SIG{'ALRM'} = sub { die("timeout in command: $command"); };
|
||||
alarm($timeout); # no test should take longer than 120 seconds
|
||||
local $SIG{'ALRM'} = sub { die("timeout in command: $command"); };
|
||||
alarm($timeout); # no test should take longer than 120 seconds
|
||||
|
||||
my $output = `$command`;
|
||||
$object->return_code($? >> 8);
|
||||
$_ = $? & 127;
|
||||
if ($_) {
|
||||
die "Got signal $_ for command $command";
|
||||
}
|
||||
chomp $output;
|
||||
$object->output($output);
|
||||
my $output = `$command`;
|
||||
$object->return_code($? >> 8);
|
||||
$_ = $? & 127;
|
||||
if ($_) {
|
||||
die "Got signal $_ for command $command";
|
||||
}
|
||||
chomp $output;
|
||||
$object->output($output);
|
||||
|
||||
alarm(0);
|
||||
alarm(0);
|
||||
|
||||
my ($pkg, $file, $line) = caller(0);
|
||||
print "Testing: $command", $/;
|
||||
if ($ENV{'NPTEST_DEBUG'}) {
|
||||
print "testCmd: Called from line $line in $file", $/;
|
||||
print "Output: ", $object->output, $/;
|
||||
print "Return code: ", $object->return_code, $/;
|
||||
}
|
||||
my ($pkg, $file, $line) = caller(0);
|
||||
print "Testing: $command", $/;
|
||||
if ($ENV{'NPTEST_DEBUG'}) {
|
||||
print "testCmd: Called from line $line in $file", $/;
|
||||
print "Output: ", $object->output, $/;
|
||||
print "Return code: ", $object->return_code, $/;
|
||||
}
|
||||
|
||||
return $object;
|
||||
return $object;
|
||||
}
|
||||
|
||||
# do we have ipv6
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue